Macro to batch process a bunch of files in a directory 2

Option Explicit

Dim swApp As Object
Dim swPart As Object
Dim swDwg As Object
Dim strNewLine3 As String
Const swDocDRAWING = 3
Const swDocPART = 1
Const swDocASSEMBLY = 2
Const swOpenDocOptions_Silent = &H1
Dim retval As Boolean, retval1 As Long, lngOha As Long
Dim sMask As String


Sub Main()
    Dim sPath As String
    Dim sFileSW As String
    Dim sFileDWG As String
    Dim sFileDXF As String
    Dim sFilePRN As String
    Dim sFileTitle As String
    Dim iParts As Integer, iAssy As Integer, iDrw As Integer
    Dim sMsg As String

 sPath = BrowseForFolder(0, "Please select a Server folder.")
If sPath = "" Then
    Exit Sub
Else
    sPath = sPath & "\"
End If
 
sMsg = "Enter drawings mask (if applicable). Use '*' for all."
sMask = InputBox(sMsg, "Drawings Mask", "*")
If sMask = "" Then sMask = "*"
 
    Set swApp = CreateObject("SldWorks.Application")
    iParts = 0
    iAssy = 0
    iDrw = 0
    
    'process parts
    sFileSW = Dir(sPath & sMask & "*.sldprt")

    Do While sFileSW <> ""
        'Open file
       Set swPart = swApp.OpenDoc2(sPath & sFileSW, swDocPART, False, False, True, lngOha)
        
        If swPart Is Nothing Then
            Call MsgBox("Unable to open document!", vbExclamation, "Line3")  ' Display error message
            End                    ' If no model currently loaded, then exit
        End If
         'counter
        iParts = iParts + 1
        'do part processing
        'save file
        retval1 = swPart.Save2(True)
        'Close File
        sFileTitle = swPart.GetTitle
        swApp.CloseDoc sFileTitle
        'Next File
        sFileSW = Dir
    Loop
    
   
    'process assemblies
    sFileSW = Dir(sPath & "*.sldasm")

    Do While sFileSW <> ""
        'Open file
        Set swPart = swApp.OpenDoc2(sPath & sFileSW, swDocASSEMBLY, False, False, True, lngOha)
        
        If swPart Is Nothing Then
            Call MsgBox("Unable to open document!", vbExclamation, "Line3")  ' Display error message
            End                    ' If no model currently loaded, then exit
        End If

        'counter
        iAssy = iAssy + 1
        'do assembly processing
        'save file
        retval1 = swPart.Save2(True)
        'Close File
        sFileTitle = swPart.GetTitle
        swApp.CloseDoc sFileTitle
        'Next File
        sFileSW = Dir
    Loop
    
    'process drawings
     sFileSW = Dir(sPath & "*.slddrw")

    Do While sFileSW <> ""
        'Open file
       Set swPart = swApp.OpenDoc2(sPath & sFileSW, swDocDRAWING, False, False, True, lngOha)
        
        If swPart Is Nothing Then
            Call MsgBox("Unable to open document!", vbExclamation, "Line3")  ' Display error message
            End                    ' If no model currently loaded, then exit
        End If

        'counter
        iDrw = iDrw + 1
        'do drawing processing
        'save file
        retval1 = swPart.Save2(True)
        'Close File
        sFileTitle = swPart.GetTitle
        swApp.CloseDoc sFileTitle
        'Next File
        sFileSW = Dir
    Loop
    
    swApp.SendMsgToUser Str(iParts) & " parts, " & Str(iAssy) & "assemblies & " & Str(iDrw) & " drawings changed in folder" & vbCrLf & _
                        sPath & " !"
                        
End Sub

Option Explicit

Public Type BrowseInfo
     hwndOwner As Long
     pIDLRoot As Long
     pszDisplayName As Long
     lpszTitle As Long
     ulFlags As Long
     lpfnCallback As Long
     lParam As Long
     iImage As Long
End Type

Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260

Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
      
    'declare variables to be used
     Dim iNull As Integer
     Dim lpIDList As Long
     Dim lResult As Long
     Dim sPath As String
     Dim udtBI As BrowseInfo

    'initialise variables
     With udtBI
        .hwndOwner = hwndOwner
        .lpszTitle = lstrcat(sPrompt, "")
        .ulFlags = BIF_RETURNONLYFSDIRS
     End With

    'Call the browse for folder API
     lpIDList = SHBrowseForFolder(udtBI)
      
    'get the resulting string path
     If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        lResult = SHGetPathFromIDList(lpIDList, sPath)
        Call CoTaskMemFree(lpIDList)
        iNull = InStr(sPath, vbNullChar)
        If iNull Then sPath = Left$(sPath, iNull - 1)
     End If

    'If cancel was pressed, sPath = ""
     BrowseForFolder = sPath

End Function