PDA

View Full Version : move pdf files



aoc
01-24-2010, 11:58 AM
Hi,

I have pdf files in folder A. In the attached file, I have the numbers. pdf names begin with the numbers in the attached file with different format. for example in the file it is 0500 327 44 88 but pdf begins with 5003274488 then comes letters. When I click the command button, it will compare all the numbers in Column A with pdf file names in folder A. If the numbers are found they will be attached in the default email to be sent to xxx@mail.com. If it is impossible, they can be cut and pasted into folder B in folder A

regards,

aoc
01-25-2010, 11:34 AM
Hi,


Is there someone to help me ?

mdmackillop
01-25-2010, 06:14 PM
Based on JP's code here (http://www.vbaexpress.com/forum/showpost.php?p=198950&postcount=5)

Add a helper column (col C in this example) =--SUBSTITUTE(A1," ","")



' adjust this line to match the folder with the files you want to attach
Const FOLDER As String = "C:\My Files\"
Sub ProcessEachFileInFolder()
On Error GoTo ErrorHandler
Dim fileName As String
Dim olApp As Object
Dim Msg As Object
Dim f
fileName = Dir(FOLDER & "*.pdf")
' if no files in folder, exit
If Len(fileName) = 0 Then GoTo ProgramExit
' get Outlook instance
Set olApp = GetOutlookApp
If olApp Is Nothing Then GoTo ProgramExit
' create new email message
Set Msg = CreateMessage(olApp)
' loop through folder compare to helper column values
'If found, attach to email
Do While Len(fileName) > 0
f = Split(fileName, ".")(0) * 1
Set c = ActiveSheet.Columns(3).Find(f, LookIn:=xlValues)
If Not c Is Nothing Then Msg.Attachments.Add FOLDER & "\" & fileName
' get next file
fileName = Dir
Loop
' display email for sending
Msg.Display
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub

Function GetOutlookApp() As Object
On Error Resume Next
Set GetOutlookApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set GetOutlookApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
End Function

Function CreateMessage(olApp As Object) As Object
Set CreateMessage = olApp.CreateItem(0)
End Function

aoc
01-26-2010, 02:12 AM
Dear Mdmackillop,

thanks for the long code, I tried but nothing happened, I did not receive error.

I could not understand what to do about below helper column ?

Add a helper column (col C in this example) =--SUBSTITUTE(A1," ","")

my default email programme is lotus notes. If it is impossible, files can only be copied to folder.

regards,