Print PDF batch scripting for a noob

[zarpenstein]

Hello,

I'm really inexperienced with VBA, as part of my system administration job I haven't compiled much code independently. At my job, an engineer had developed a script to run on Office 2003 32-bit, and we're just now migrating everyone to Office 2016 64-bit. Part of the problem I've seen is that numerous changes between the versions of Office have modified or even removed certain arguments, and one used heavily was Application.Filesearch but that's no longer a valid call in a function. Pasted below is the code I am trying to upgrade, thank you for any help:

Option Explicit
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sub Print_PDFs()

Dim folder As String
Dim PDFfilename As String
Dim n As Integer
Dim tempn As Integer
Dim lastRow As Integer
Dim I2 As Long
Dim I3 As Long
Dim rev As String
Dim partName As String
Dim fileList As String
Dim missList As String
Dim skipList As String
Dim list() As Variant


n = 0

fileList = "Printed:"
missList = "Missing:"
skipList = "Skipped:"

folder = "Y:\" 'CHANGE AS REQUIRED

Process_BOM
list = ListDirectory(folder)

lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

For I2 = 2 To lastRow
If InStr(Cells(I2, "F"), "PURCHASED") = 0 And InStr(Cells(I2, "F"), "INV") = 0 And InStr(Cells(I2, "F"), "COMP") = 0 And InStr(Cells(I2, "F"), "HARDWARE") = 0 Then
rev = Cells(I2, "B")
partName = Cells(I2, "A")
tempn = n
For I3 = 1 To UBound(list)
If InStr(UCase(CStr(list(I3))), UCase(partName)) Then
If InStr(UCase(CStr(list(I3))), "_" & UCase(rev)) Then
PDFfilename = CStr(list(I3))
Print_Input PDFfilename
n = n + 1
fileList = fileList & vbNewLine & PDFfilename & " - " & Cells(I2, "F")
I3 = UBound(list)
End If
End If
Next I3
If tempn = n Then
If InStr(Cells(I2, "F"), "REFERENCE DRAWING") <> 0 Then
PDFfilename = UCase(partName) & "_" & UCase(rev) & ".pdf"
Print_Input folder & "RD" & Chr(39) & "s Reference Drawings\" & PDFfilename
fileList = fileList & vbNewLine & PDFfilename & " - " & Cells(I2, "F")
Else
missList = missList & vbNewLine & partName & "_" & rev & ".pdf" & " - " & Cells(I2, "F")
End If
End If
Else
skipList = skipList & vbNewLine & Cells(I2, "A").Value & " - " & Cells(I2, "F")
End If
Next I2

Open "Print Sheet.txt" For Output As #1

Write #1, fileList

Write #1, missList

Write #1, skipList

Close #1

Print_Input Application.DefaultFilePath & "\Print Sheet.txt"

MsgBox n & " files have been printed"

End Sub

Private Sub Print_Input(sPDFfile As String)
Shell "C:\Program Files\Java\jre7\bin\java.exe Print_PDFS " & Chr(34) & sPDFfile & Chr(34), vbNormalFocus
Sleep (500)
End Sub

Private Function ListDirectory(folder As String) As Variant
Dim fs As FileSearch, list() As Variant, I As Long
Set fs = Application.FileSearch
With fs
.SearchSubFolders = False ' set to true if you want sub-folders included
.FileType = msoFileTypeAllFiles 'can modify to just Excel files eg with msoFileTypeExcelWorkbooks
.LookIn = folder 'modify this to where you want to serach
If .Execute > 0 Then
ReDim list(1 To .FoundFiles.Count)
For I = 1 To .FoundFiles.Count
list(I) = .FoundFiles(I)
Next
Else
MsgBox "No files found"
End If
End With
ListDirectory = list
End Function

Private Sub Process_BOM()

Dim I As Long
Dim lastRow As Integer
Dim partName() As String

Columns("D").TextToColumns
Columns("D").NumberFormat = "0"

Columns("E").TextToColumns
Columns("E").NumberFormat = "0.00"

lastRow = Cells(Rows.Count, "A").End(xlUp).Row

For I = 2 To lastRow
If InStr(Cells(I, "A"), ".") <> 0 Then
partName() = Split(Cells(I, "A"), ".")
Sheets("Sheet1").Cells(I, "A").Value = partName(0)
End If
If IsNumeric(Cells(I, "A")) = True Then
If Cells(I, "A") < 10000 Then
Cells(I, "A").NumberFormat = "00000"
End If
End If
If InStr(Cells(I, "B"), ".") <> 0 Then
partName() = Split(Cells(I, "B"), ".")
Cells(I, "B").Value = partName(0)
End If
Next I

Range("A1:F" & lastRow).Sort _
Key1:=Range("A1"), Header:=xlYes

Range("A2").Select

Do Until ActiveCell = ""
For I = 2 To lastRow
If ActiveCell.Row <> Cells(I, "A").Row Then
If ActiveCell.Value = Cells(I, "A").Value Then
ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(0, 3).Value + Cells(I, "D").Value
Rows(I).Delete
I = I - 1
End If
End If
Next I
ActiveCell.Offset(1, 0).Select
Loop

Range("A2").Select

End Sub

[Kenneth Hobs]

Welcome to the forum! Please paste code between code tags. Click the # on the toolbar to insert the tags.

Application.FileSearch is the biggy. API commands like at the top of your code will be a problem here and there due to 64 bit. This becomes even more of a problem when some have 32 bit and some 64 bit. Those cases can be handled but takes more code.

For a replacement of Application.FileSearch, my preferred method depends on if I am looking at one folder or subfolders and all files or certain file types.

I have a class method similar to Application.FileSearch. It does not do all what it did but does the bulk of it. Other methods are WScript, Shell(), Application.Shell, FSO, and Dir().

For now, let's see if this WScript method will meet your needs. I has 3 test Subs showing various ways to call it. To learn more options you can use with my aFFs() which returns a variant array like your ListDirectory(), see the commented ss64.com link.

If this works for you, you could just replace your ListDirectory() with aFFs() and sA1dtovA1d(). Of course aFFs() gives two more options than ListDirectory() so you will have an even more useful tool.

Sub test_aFFs()  
  Dim x() As Variant
  
  x() = aFFs("x:\t\")
  MsgBox Join(x(), vbLf)
  MsgBox x(0), vbInformation, "First File"
  MsgBox x(1), vbInformation, "Second File"
  
  x() = aFFs("x:\t*", "/ad")  'Search for folders in x:\ that start with the letter "t".
  MsgBox Join(x(), vbLf)
  
  x() = aFFs("x:\t*", "/ad", True) 'Search for subfolders in x:\ that start with the letter "t".
  MsgBox Join(x(), vbLf)
End Sub




Sub test2_aFFs()
  Dim x() As Variant
  
  x() = aFFs("x:\t\")
  MsgBox Join(x(), vbLf)
  MsgBox x(0), vbInformation, "First File"
  MsgBox x(1), vbInformation, "Second File"
  
  x() = aFFs("x:\t*", "/ad")  'Search for folders in x:\ that start with the letter "t".
  MsgBox Join(x(), vbLf)
  
  x() = aFFs("x:\t*", "/ad", True) 'Search for subfolders in x:\ that start with the letter "t".
  MsgBox Join(x(), vbLf)
End Sub


Sub aFFs_Test()
  Dim x() As Variant, s() As String, i As Long
  x() = aFFs("c:\myfiles\excel\msword\*.doc")
  MsgBox Join(x, vbLf)
  For i = LBound(x) To UBound(x)
    'Do your thing here, e.g.
    'MsgBox x(i)
  Next i
End Sub


Sub MyFoldersAndDatesCreated()
  Dim a() As Variant, b() As Variant, i As Long
  Dim fso As Object
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  a() = aFFs("x:\", "/ad", True)
  
  'MsgBox Join(a(), vbLf)
  Range("A1").Resize(UBound(a) + 1, 1).Value2 = WorksheetFunction.Transpose(a)
  
  b() = a() 'Set array to holder folder creation dates the same size
  For i = LBound(a) To UBound(a)
    b(i) = fso.GetFolder(b(i)).DateCreated
  Next i
  
  Range("B1").Resize(UBound(a) + 1, 1).Value2 = WorksheetFunction.Transpose(b)
  
  Range("A:B").EntireColumn.AutoFit
End Sub




'Set extraSwitches, e.g. "/ad", to search folders only.
'MyDir should end in a "\" character unless searching by wildcards, e.g. "x:\test\t*
'Command line switches for the shell's Dir, http://ss64.com/nt/dir.html
Function aFFs(myDir As String, Optional extraSwitches = "", _
  Optional tfSubFolders As Boolean = False) As Variant
  
  Dim s As String, a() As String, v As Variant
  Dim b() As Variant, i As Long
  
  If tfSubFolders Then
    s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
      """" & myDir & """" & " /b /s " & extraSwitches).StdOut.ReadAll
    Else
    s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
      """" & myDir & """" & " /b " & extraSwitches).StdOut.ReadAll
  End If
  
  a() = Split(s, vbCrLf)
  If UBound(a) = -1 Then
    MsgBox myDir & " not found.", vbCritical, "Macro Ending"
    Exit Function
  End If
  ReDim Preserve a(0 To UBound(a) - 1) As String 'Trim trailing vblfcr
  
  For i = 0 To UBound(a)
    If Not tfSubFolders Then
      s = Left$(myDir, InStrRev(myDir, "\"))
      'add the folder name
      a(i) = s & a(i)
    End If
  Next i
  aFFs = sA1dtovA1d(a)
End Function


Function sA1dtovA1d(strArray() As String) As Variant
  Dim varArray() As Variant, i As Long
  ReDim varArray(LBound(strArray) To UBound(strArray))
  For i = LBound(strArray) To UBound(strArray)
    varArray(i) = CVar(strArray(i))
  Next i
  sA1dtovA1d = varArray()
End Function

[zarpenstein]

Kenneth,

I'm not seeing an option to edit the post, when I click on # it just takes me to the post without being able to modify the contents.

However, the option from ss64 worked! I love that site, I use it for a lot of reference material. I was able to print my batch files from the BOM we exported, it worked without much trouble. Thank you so much, I feel like I'm understanding more now what this code was trying to do.

[Kenneth Hobs]

After a time, edit option goes away. The # icon is on the edit or reply or the Go Advanced button's, dialogs.

Of course you can always type the codes. e.g. (code)MsgBox "hi"(/code) but replace ()'s with []'s.