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…