I’m trying to create an automated manufacturing history system to create a report, and copy attachments from a job card & email them. The file names have to be specific format..so need to be assigned from a variable.
Code below Creates a temp folder, create/save MHR report in the temp folder, Gets the attachments related to the job but then falls over at the copy and paste the attachment to the temp folder
Dim appOutLook As Outlook.Application, MailOutLook As Outlook.MailItem
Dim fso As Object, SourceFolder As Object, SourceFile As Object
Dim Jnum As Long
Dim reportName As String
Dim criteria As String
Dim FiNm As String
Dim strSQL As String
Dim rs As Recordset
Dim db As DAO.Database
Dim FindRecordCount As String
Dim FromPath As String
Dim ToPath As String
Dim FileInFromFolder As Object
Const strPath As String = "C:UserssamhaOneDriveDesktopMHR_Reporting_temp"
Const strPath2 As String = "C:UserssamhaOneDriveDesktopMHR_Reporting_temp"
Dim FiNm2 As String
Dim FileCopy As Object
reportName = "MHR_V1"
FiNm = "Test.pdf"
criteria = "[Job Number] = " & 9150 & ""
Jnum = "9150"
Set db = CurrentDb
FiNm2 = "Test2.pdf"
'create the attachments folder
If Dir(strPath, vbDirectory) = "" Then
MkDir strPath
End If
'Creates and saves MHR report
DoCmd.OpenReport reportName, acViewPreview, , criteria, acWindowNormal
DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, strPath & FiNm
DoCmd.Close acReport, reportName, acSaveNo
'gets attachments
strSQL = "SELECT t_Attachments_Server.[Job Number], t_Attachments_Server.[FullFileName], t_Attachments_Server.[Op Description] " & vbCrLf & _
"FROM t_Attachments_Server " & vbCrLf & _
"WHERE (((t_Attachments_Server.[Job Number])= " & Jnum & " ));"
Set rs = db.OpenRecordset(strSQL)
Set fso = CreateObject("scripting.FileSystemObject")
With rs
If rs.EOF Then
FindRecordCount = 0
Else
rs.MoveLast
FindRecordCount = rs.RecordCount
rs.MoveFirst
End If
Do Until rs.EOF
If Not rs.EOF Then
FromPath = rs![FullFileName]
ToPath = strPath2
fso.FileCopy FromPath, ToPath & FiNm2
End If
rs.MoveNext
Loop
End With
'open email and attach files
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.BodyFormat = olFormatRichText
.To = "[email protected]"
'.CC = " "
.Subject = "MHR Autoserver"
.HTMLBody = "Your text "
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(strPath)
For Each SourceFile In SourceFolder.Files
.Attachments.Add SourceFile.Path 'SourceFolder.Path contains the path+filename
Next
.Display
'.Send
'close fso objects
Set SourceFile = Nothing
Set SourceFolder = Nothing
Set fso = Nothing
End With
'delete all files in the folder
Kill strPath & "*.*"
'delete folder
RmDir strPath
Its the fso.FileCopy FromPath, ToPath & FiNm2 not working…
any suggestions what is the correct way to copy a file and paste/rename while looping through a record set??
the attach to email & delete folder works…