Reputation: 31
I tried this code below (shout-out to source provider) and now I want to add a little extra code, however I can't get f.Move function to work. In other words, I want to move PDF files from one folder to another file folder. Any suggestions?
Dim origWB As Workbook
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com
Set origWB = ActiveWorkbook
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
'Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
myPath = "L:\TEST FOLDER"
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.pdf*"
'Target Path with Ending Extention
Dim Rngemployees As Range
Dim employee
Dim numrows As Long
Dim DOCKET As Workbook
Dim Fab As String
Dim TrackingNumberRange As Range
Dim I
Dim Ii As String
Dim NumrowsManual45DaysRM As Integer
Dim EfilePath As String
NumrowsManual45DaysRM = Sheets("Manual45days").Range("H2").End(xlDown).Row
Set TrackingNumberRange = Sheets("Manual45days").Range("H2:H" & NumrowsManual45DaysRM)
Dim fso As Object
Dim Fldr As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fldr = fso.getfolder(myPath).Files
Dim f As Object
'Loop through each Excel file in folder
For Each f In Fldr
myFile = Dir(myPath & myExtension)
If Len(Dir$(myPath & myFile)) > 0 Then
SetAttr (myPath & myFile), vbNormal 'This will probably allow you to modify the path of the file
End If
Debug.Print f.Name
For Each I In TrackingNumberRange.Cells
Ii = I.Value
Ii = Replace(I, " ", "", 1, 3, vbBinaryCompare)
If f.Name = Ii & ".pdf" Then
Sheets("Manual45Days").Range("A" & I.Row) = "Signature Received"
EfilePath = Sheets("Manual45Days").Range("T" & I.Row).Value
EfilePath = Replace(EfilePath, " ", " ")
Debug.Print EfilePath
f.Move (EfilePath) ''This line I am having Trouble with'''
Debug.Print I.Row
End If
Next
Next f
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
ThanksThanksThanksThanksThanksThanksThanksThanksThanksThanksThanks Thanks Thanks Thanks Thanks Thanks
Upvotes: 0
Views: 954
Reputation: 31
For anyone wondering, I found the answer and it worked :) All I had to do is add a "" to the end of my desired destination path as below:
EfilePath = Replace(EfilePath, " ", " ") & "\"
Debug.Print EfilePath
f.Move EfilePath
Upvotes: 1