Misc. Examples

Misc. Example code from the seminar (modMiscExamples)

Option Explicit

Sub FolderFullFromArray()
    ' Uses array to collect filenames for processing
    ' This is more reliable than processing the files within a loop
    ' that includes DIR

    Dim rayFileNames() As String
    Dim strCurrentFile As String    ' variable to hold a single file name
    Dim strFileSpec As String       ' variable to hold our file spec
    ' give it a value that works for my computer:
    strFileSpec = "C:\Documents and Settings\Stephen Rindsberg\Desktop\PPTLive\Automation\LotsOfFiles\*.ppt"

    ' Redimension the array to 1 element
    ReDim rayFileNames(1 To 1) As String

    ' get the first file that matches our specification
    strCurrentFile = Dir$(strFileSpec)

    ' don't do anything if we didn't find any matching files
    ' but if we did, keep processing files until we don't find any more
    While Len(strCurrentFile) > 0
        ' Add it to the array
        rayFileNames(UBound(rayFileNames)) = strCurrentFile
        strCurrentFile = Dir
        ' redimension the array
        ReDim Preserve rayFileNames(1 To UBound(rayFileNames) + 1) As String
    Wend

    ' If there were no files, the array has one element
    ' If it has more than one element, the last element is blank
    If UBound(rayFileNames) > 1 Then
        ' lop off the last, empty element
        ReDim Preserve rayFileNames(1 To UBound(rayFileNames) - 1) As String
    Else
        ' no files found
        Exit Sub
    End If

    ' If we got this far, we have files to process in the array so
    Dim x As Long

    For x = 1 To UBound(rayFileNames)

        ' open the presentation
        Presentations.Open (rayFileNames(x))
        Debug.Print ActivePresentation.Name

        ' call the Green to Red macro to process the file
        Call GreenToRed

        ' save the file under a new name with FIXED_ at the beginning
        ActivePresentation.SaveAs (ActivePresentation.Path & "\" _
            & "Fixed_" _
            & ActivePresentation.Name)

        ' close it
        ActivePresentation.Close
    Next x

End Sub

Click Next to continue