VBA Excel Ignores PrintArea Pdf - vba

I have 250 excel documents where I try to print a sheet for pdf. If I do it manually, it will be 4 pages, but if I use my code, it will be 7 pages long.
It's like it ignores the print area, and makes several blank pages.
Can any of you figure out the mistake?
Dim wb As Workbook
Dim xExtension As String: xExtension = "*.xls*"
Dim xFolder As String: xFolder = [MailFolder]
Dim xFile As String: xFile = Dir(xFolder & xExtension) 'DIR gets the first file of the folder
Dim Rng As Range: Set Rng = Range("A1")
Dim s As String
Do While xFile <> "" 'Loop through all files in a folder until DIR cannot find anymore
Set wb = Workbooks.Open(xFolder & xFile): wb.Activate
Call WorksheetsToPDF(wb, "F:\VBA\PDF\Udlejning\" & CleanFileName("Police - " & "2021 -" & [KompletPoliceNr] & " - " & [Forsikringstager]) & ".pdf", "Certifikat")
'Call WorksheetsToPDF(wb, "F:\VBA\KF Begæringer\" & CleanFileName("KF Begæring-2021-" & [KompletPoliceNr] & "-" & [Forsikringstager]) & ".pdf", "Police")
wb.Close savechanges:=False
xFile = Dir()
Loop
End Sub
Private Sub WorksheetsToPDF(wb As Workbook, DistinationPath As String, ParamArray Arr() As Variant)
wb.Sheets(Arr()).Select
Debug.Print EFDK.GetNextavailablefilename(DistinationPath)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=EFDK.GetNextavailablefilename(DistinationPath), Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
End Sub
Private Function GetNextAvailableFilename(ByVal xPath As String) As String
With CreateObject("Scripting.FileSystemObject")
Dim strFolder As String, strBaseName As String, strExt As String, i As Long
strFolder = .GetParentFolderName(xPath)
strBaseName = .GetBaseName(xPath)
strExt = .GetExtensionName(xPath)
Do While .FileExists(xPath)
i = i + 1
xPath = .BuildPath(strFolder, strBaseName & " - " & i & "." & strExt)
Loop
End With
GetNextAvailableFilename = xPath
End Function

You did not answer my clarification questions...
Just for the sake of testing, please try the next adapted function:
Private Sub WorksheetsToPDF(wb As Workbook, DistinationPath As String, ParamArray arr() As Variant)
Dim El
wb.Sheets(arr()).Select
For Each El In arr()
wb.Sheets(El).PageSetup.FitToPagesWide = 1
wb.Sheets(El).PageSetup.PaperSize = xlPaperA4 ' xlPaperLetter
wb.Sheets(El).PageSetup.Orientation = xlLandscape
Next
'Debug.Print EFDK.GetNextavailablefilename(DistinationPath)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=EFDK.GetNextavailablefilename(DistinationPath), Quality:=xlQualityStandard, IncludeDocProperties:=True
End Sub

Related

Save each worksheet from workbook as individual pdfs

What I have is a workbook with all the sales from all the sales associates in "Sheet", and in the other sheets the sheets are named by the sales person number ("41", "51", "88", etc.) with their sales. What I want the macro to do is take each worksheet and save as a pdf with "worksheet name" & "Filename"
My question is related to this post, but for some reason my version is not saving the pdf's properly.
excel vba - save each worksheet in workbook as an individual pdf
So what I want is simple: take each worksheet and save into it's own unique pdf. The problem I'm having is that the macro is saving each individual sheet with the right filename, but when I open the pdf, its the same sales associate for each pdf.
here is the code:
Option Explicit
Sub WorksheetLoop()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active workbook.
Set wbA = ActiveWorkbook
WS_Count = wbA.Worksheets.Count
strPath = wbA.Path
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
' Begin the loop.
For I = 1 To WS_Count
'replace spaces and periods in sheet name
strName = Replace(wbA.Worksheets(I).Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
myFile = strPath & strFile
Debug.Print myFile
'export to PDF if a folder was selected
If myFile <> "False" Then
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
Next I
End Sub
let me know if you need any additional details
you need to activate Activate each worksheet before you print them into pdf. Try this
' Begin the loop.
For Each wsA In wbA.Sheets
wsA.Activate
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
myFile = strPath & strFile
Debug.Print myFile
'export to PDF if a folder was selected
If myFile <> "False" Then
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
Next
You should first activate each sheet before you export it as PDF. Try:
Option Explicit
Sub WorksheetLoop()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active workbook.
Set wbA = ActiveWorkbook
WS_Count = wbA.Worksheets.Count
strPath = wbA.Path
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
' Begin the loop.
For Each wsA In wbA.Worksheets
wsA.Activate
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
myFile = strPath & strFile
Debug.Print myFile
'export to PDF if a folder was selected
If myFile <> "False" Then
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
Next wsA
End Sub

Excel VBA: Run Time Error 5 - Invalid Procedure Call or Argument

I have a macro in excel which loops over the tabs and saves the tabs as PDFs in a given folder.
The macro partially works, it creates a few PDFs but then stops and throws this error:
Run Time Error 5 - Invalid Procedure Call or Argument
Here is my code:
Option Explicit
Sub WorksheetLoop()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim rng As Range
' Prevents screen refreshing.
Application.ScreenUpdating = False
Set wbA = ActiveWorkbook
strPath = wbA.Path
strTime = Format(Now(), "yyyymmdd")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
' Begin the loop.
For Each wsA In ActiveWorkbook.Worksheets
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
If strName = "Macro" Then
MsgBox "That's all folks! :)"
Exit Sub
End If
If strName = "TOUCHPOINTS" Then
strName = "Touchpoints by markets"
End If
If strName = "VIDEOHOURS" Then
strName = "Viewing Hours by markets"
End If
If strName = "TARGETS" Then
strName = "Shares by markets"
End If
If strName = "SHARESCHANNELS" Then
strName = "IGNORE ME"
End If
If strName = "TOP10PREMIERES" Then
strName = "Top 10 Premieres by markets"
End If
If strName = "SHARETREND" Then
strName = "Share trends last 13 months"
End If
If strName = "COMPETITION" Then
strName = "Share overview international media companies"
End If
If strName = "COMPETITIONSHARETREND" Then
strName = "Share trends factual competitors last 13 months"
End If
If strName = "PUT" Then
strName = "PUT level"
End If
If strName = "CHANNELRANKER" Then
strName = "Top 20 Channels by Market"
End If
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
myFile = strPath & strFile
Debug.Print myFile
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
Next wsA
' Enables screen refreshing.
Application.ScreenUpdating = True
End Sub
Probably the error is here:
If myFile <> "False" Then
I guess that it should be simply like this -> If myFile Then or If len(myFile) >8 Then
However, the code looks working. Just try to rebuild it with Select Case, it looks way better and slightly faster:
Select Case strName
Case "Macro"
MsgBox "That's all"
Exit Sub
Case "TOUCHPOINTS"
strName = "Touchpoints by markets"
Case Else
Debug.Print "I don't know -> "; strName
End Select
Probably you will find the error then.

Save each worksheet in workbook as an individual pdf

I want to loop over all worksheets in a workbook and save them as individual pdfs in the same path as the workbook. The files are named after the worksheet name.
This code below works up until the "wsA.ExportAsFixedFort" line. The error message i get is:
Run-time error '91': Object variable or With block variable not set
But i cant figure out what the issue is...
Any suggestions?
Option Explicit
Sub WorksheetLoop()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active workbook.
Set wbA = ActiveWorkbook
WS_Count = wbA.Worksheets.Count
strPath = wbA.Path
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
' Begin the loop.
For I = 1 To WS_Count
'replace spaces and periods in sheet name
strName = Replace(wbA.Worksheets(I).Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
myFile = strPath & strFile
Debug.Print myFile
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
Next I
End Sub
Try to change like this:
If myFile <> "False" Then
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Then try to find a way how to loop through the sheets, its a trivial VBA task.
In general, in your code wsA was not set. Thus, you got an error.

How to merge 3 VBA commands in to one? Set print range without absolute reference

I'm trying to solve a situation where I have a range of text that can vary considerably depending on the results returned by an array formula. Sometimes there may be 5 rows of data, other times there may be 2000.
I think I've found the chunks of individual VBA codes required for each stage of the task I want to complete, but I am a complete novice with VBA and I have no idea how to piece these together.
The following selects all the actual data on the page, and excludes any rows that contain a hidden formula:
Sub PickedActualUsedRange()
Range("A1").Resize(Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select
End Sub
So far so good. This is the exact range I want to print.
I also want the row height to be adjusted automatically, as each cell may contain a string of text of varying lengths that may be wrapped. So again the following command needs to go in:
Selection.Rows.AutoFit
Not too much trouble so far.
However, for the next bit I would like the VBA to use the selection made above, and to set this as the new print range. However, the code I have found seems to require me to set an absolute range (as per below), whereas I need this to adjust in accordance to the first selection
Selection.PageSetup.PrintArea = "$A$1:$B$12"
Once this is in place, the next step I would like to incorporate is this code I found via from the contextures website for printing the current worksheet:
Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
Is anybody able to help me incorporate all of the above in to a single string of code please?
FURTHER EDIT
Still not sure what I'm doing with different chunks of code. What would be the exact text I would need to enter in Module1? I don't understand how to structure it:
'Function to give the actual data range from a given worksheet
Function PickedActualUsedRange(ws As Worksheet) As Range
Set PickedActualUsedRange = ws.Range("A1").Resize(Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
End Function
Sub PDFSheet(wsA As Worksheet) '<-- the sheet in question will be given as parameter
' Drop or change the following lines...
' Dim wsA As Worksheet '<-- drop
' Dim wbA As Workbook '<-- drop
...
strPath = wsA.Parent.Path ' <-- change
...
End Sub
Sub mySyb()
Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
End Sub
Sub mySyb()
Dim ws As Worksheet: Set ws = Worksheets("report")
Dim r As Range: Set r = PickedActualUsedRange(ws)
r.Rows.AutoFit
ws.PageSetup.PrintArea = r.Address
PDFSheet (ws)
End Sub
To fit it the easiest way with your current code, here's how you would setup the print area:
ActiveSheet.PageSetup.PrintArea = Selection.address
And you can call your routines in order
PickedActualUsedRange
Selection.Rows.AutoFit
ActiveSheet.PageSetup.PrintArea = Selection.address
PDFActiveSheet
On a final note, your code uses unqualified ranges and counts a lot on Select, Selection, ActivateSheet etc... which is usually considered bad practice (code will be difficult to maintain). You'd better change it to get rid of these and use explicit sheet names and qualified ranges.
EDIT
' Function to give the actual data range from a given worksheet
Function PickedActualUsedRange(ws as Worksheet) as Range
Set PickedActualUsedRange = ws.Range("A1").Resize(ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
ws.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
End Function
Sub PDFSheet(wsA As Worksheet)
'www.contextures.com
'for Excel 2010 and later
Dim strTime As String, strName As String, strPath As String, strFile As String, strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wsA.Parent.Path & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
Sub myMacro
Dim ws as worksheet: Set ws = Worksheets("report")
Dim r as range: Set r = PickedActualUsedRange(ws)
r.Rows.AutoFit
ws.PageSetup.PrintArea = r.address
PDFSheet ws
End Sub
Put all this in a code module (i.e. Module1) and call the myMacro through ALT
+ F8

How to edit multiple excel files each of which are in a different folder united in one folder

This question isn't supposed to be complicated. I have one big folder and in it it has 200 individual folders. Now each of those folders has one excel sheet in it. I want to have some code in a vba file in control folder (which is next to the 200) which can iterate over the 200 folders and change one bit of data in each excel file. I found directory stuff and folder iterations, However I can't take bit for here and there and merge them together, i need some simple help.
my code is currently: `Sub Button1_Click()
Dim wb As Workbook
Dim ws As Excel.Worksheet
Dim iIndex As Integer
Dim strPath As String
Dim strFile As String
'Get the directories
strPath = "C:\Users\generaluser\Desktop\testing main folder\"
strFile = Dir(strPath, vbDirectory)
'Loop through the dirs
Do While strFile <> ""
'Open the workbook.
strFileName = Dir(strPath & strFile & "New Microsoft Excel Worksheet.xlsm", vbDirectory)
'Open the workbook.
Set wb = Workbooks.Open(Filename:=strPath & strFile & "\" & strFileName, ReadOnly:=False)
'Loop through the sheets.
Set ws = Application.Worksheets(1)
'Do whatever
'Close the workbook
wb.Close SaveChanges:=True
'Move to the next dir.
strFile = Dir
Loop
End Sub
`
Please help #MatthewD
Since you didn't show code, it's something like this.
Dim wb As Workbook
Dim ws As Excel.Worksheet
Dim iIndex As Integer
Dim strPath As String
Dim strFile As String
'Get the directories
strPath = "c:\temp\"
strFile = Dir(strPath, vbDirectory)
'Loop through the dirs
Do While strFile <> ""
'Open the workbook.
Set wb = Workbooks.Open(filename:=strPath & strFile & "\filename.xlsx", ReadOnly:=True)
'Loop through the sheets.
For iIndex = 1 To Application.Worksheets.count
Set ws = Application.Worksheets(iIndex)
'Do whatever
Next iIndex
'Close the workbook
wb.Close SaveChanges:=False
'Move to the next dir.
strFile = Dir
Loop
If the workbook names are not known, you'll have to dir the xlsx file in the dir.
strFileName = Dir(strPath & strFile & "*.xlsx")
'Open the workbook.
Set wb = Workbooks.Open(filename:=strPath & strFile & "\" & strFileName , ReadOnly:=True)
Ok, this should be pretty easy. Simply list every file in all the folders, recursively. The script below will do that for you.
Sub ListAllFiles()
SearchForFiles "C:\Users\rshuell001\Desktop\YourFolder\", "writefilestosheet", "*.*", True, True
End Sub
Sub searchForFiles(ByVal DirToSearch As String, ByVal ProcToCall As String, _
Optional ByVal FileTypeToFind As String = "*.*", _
Optional ByVal SearchSubDir As Boolean = False, _
Optional ByVal FilesFirst As Boolean = False)
On Error GoTo ErrXIT
If Right(DirToSearch, 1) <> Application.PathSeparator Then _
DirToSearch = DirToSearch & Application.PathSeparator
If FilesFirst Then processFiles DirToSearch, ProcToCall, FileTypeToFind
If SearchSubDir Then processSubFolders DirToSearch, ProcToCall, _
FileTypeToFind, SearchSubDir, FilesFirst
If Not FilesFirst Then _
processFiles DirToSearch, ProcToCall, FileTypeToFind
Exit Sub
ErrXIT:
MsgBox "Fatal error: " & Err.Description & " (Code=" & Err.Number & ")"
Exit Sub
End Sub
Private Sub processFiles(ByVal DirToSearch As String, _
ByVal ProcToCall As String, _
ByVal FileTypeToFind As String)
Dim aFile As String
aFile = Dir(DirToSearch & FileTypeToFind)
Do While aFile <> ""
Application.Run ProcToCall, DirToSearch & aFile
aFile = Dir()
Loop
End Sub
Sub writeFilesToSheet(ByVal aFilename As String)
With ActiveSheet
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = aFilename
End With
End Sub
Next, as you're aware of, you'll need to access each file, using the technique above, open each, make your change, save it, and close the file. Use the technique described from the URL below, to make the changes.
http://www.rondebruin.nl/win/s3/win010.htm
You'll have to modify the script just a bit, because that looks for all files on one folder, you need Ron's script to run through the different paths you created with the first script