More VBA Sample Code

Here’s some more code to use.


Sub test()
    Dim pDoc As IDocument
    Dim pApp As IApplication
    
    Set pDoc = New MxDocument
    Set pApp = pDoc.Parent
    
    pApp.Visible = True
    pApp.OpenDocument ("G:12171217-014GISFilesSEIFilesArcGISProjectsFieldTransects2.mxd")
    pApp.RefreshWindow
End Sub

Sub setRelativePaths()
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    pMxDoc.RelativePaths = True
End Sub


#! perl

use strict;
use Win32::OLE qw(in with);
use Win32::OLE::Const 'ESRI ArcMapUI Object Library';
use Data::Dumper;

# my $class = 'esriCarto.IMapDocument';
# my $class = 'esriArcMap.Application';
# my $class = 'esriFramework.IApplication';
# 'esriArcMapUI.MxDocument'

# print Dumper( Win32::OLE::Const->Load('ESRI ArcMapUI Object Library') );

my $pDoc = Win32::OLE->new( 'esriArcMapUI.MxDocument', 'Shutdown' ); # || die Win32::OLE->LastError()." no $class";

print Dumper( $pDoc );

my $pApp = $pDoc->Parent();
$pApp->{Visible} = 1;

print Dumper( $pApp );

$pApp->Shutdown();

exit;

$pApp->Visible = 1;
$pApp->OpenDocument( '' );



Private Sub test()
Dim pDoc As IDocument
Dim pMxDoc As IMxDocument
Dim pApp As esriFramework.IApplication
Dim pDocDS As IDocumentDatasets
Dim pEnumDS As IEnumDataset
Dim pDS As IDataset
Dim pWS As IWorkspace

    ' get a ref to a new ArcMap application
    Set pDoc = New MxDocument
    Set pApp = pDoc.Parent

    ' Loop thru your .mxd documents here

        ' Open an existing document
        pApp.OpenDocument "c:MyMap.mxd"
        Set pMxDoc = pApp.Document

        ' Iterate thru the datasets and display details
        Set pDocDS = pMxDoc
        Set pEnumDS = pDocDS.Datasets
        Set pDS = pEnumDS.Next
        While Not pDS Is Nothing
    
            On Error Resume Next
            Set pWS = pDS.Workspace
            If Err.Number = 0 Then
                Debug.Print pDS.Workspace.PathName + " : " + pDS.Name
            Else
                Debug.Print pDS.BrowseName + " : Error with datasource"
            End If
            On Error GoTo 0
        
            Set pDS = pEnumDS.Next
        Wend

    ' End of you loop

    ' Shut down the ArcMap application
    pApp.Shutdown

End Sub


--------------------------------------------------------------

Sub muliplemxds()
  
  Dim sDir As String
  Dim sFile As String
  Dim DocPath As String
    sDir = "C:MyfolderTestFolder"
    sFile = Dir(sDir & "*.mxd", vbNormal)

Do While sFile <> ""
        DocPath = sDir & sFile
        OpenMXDDoc DocPath
              
        sFile = Dir
    Loop

End Sub
Private Sub OpenMXDDoc(sFileName As String)
    On Error Resume Next
    
    Dim pDoc As IMapDocument
    Set pDoc = New MapDocument
     
    pDoc.Open sFileName
    
    
    Documentation pDoc
    
    pDoc.Close
    Set pDoc = Nothing
    
End Sub
Private Sub Documentation(pMxDoc As IMapDocument)
 Dim mapcount As Long, LayerCount As Long, text As String
 text = ""
   Dim pLayer As ILayer
   Dim pFL As IFeatureLayer
   Dim pRL As IRasterLayer
   Dim pFC As IFeatureClass
   Dim pDS As IDataset
   Dim pMap As IMap
    text = text & vbCrLf & pMxDoc.DocumentFilename
   For mapcount = 0 To pMxDoc.mapcount - 1
        Set pMap = pMxDoc.Map(mapcount)
      
            For LayerCount = 0 To pMap.LayerCount - 1
            Set pLayer = pMap.Layer(LayerCount)
            If TypeOf pLayer Is IFeatureLayer Then
              Set pFL = pLayer
              Set pFC = pFL.FeatureClass
              Set pDS = pFC
              text = text & vbCrLf & pFC.AliasName & vbCrLf & pDS.BrowseName & vbCrLf & pDS.Workspace.PathName
            ElseIf TypeOf pLayer Is IRasterLayer Then
              Set pRL = pLayer
              text = text & vbCrLf & pRL.FilePath
              Else
              text = text & vbCrLf & pLayer.name
              End If
              Next
    Next
    WriteToTextFile "C:textfile.txt", text
   
End Sub
Sub WriteToTextFile(sFileName As String, text As String)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    'Set fso = New Scripting.FileSystemObject
    Dim ts
    'Create File if doesn't exist, if it does, append to the current File
    Set ts = fso.OpenTextFile(sFileName, 8, True)
    ts.WriteLine text
    
    ts.Close
    Set ts = Nothing
    Set fso = Nothing

End Sub

-------------------------------

use Win32::OLE;
my $class = "esriGeoprocessing.GpDispatch.1";
my $gp = Win32::OLE->new($class) || die "Could not create a COM $class object";
$gp->{overwriteoutput} = 1;
print $gp->{overwriteoutput};

 -
----------------------------------------