These are the two functions I used. I still need to refine them to add the error traps as well as verification of copy and some feedback, but the process is working.
Code:
Function selectFile()
Dim fd As FileDialog, FileName As String
Dim PrintPath As String
Dim PrintItem As String
Debug.Print
On Error GoTo ErrorHandler
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
If fd.Show = True Then
If fd.SelectedItems(1) <> vbNullString Then
FileName = fd.SelectedItems(1)
End If
Else
'Exit code if no file is selected
End
End If
'Return Selected FileName
selectFile = FileName
PrintPath = GetDBPath & "Prints\"
PrintItem = Forms!frmItemDetail!txtItemNbr
Call CopyFile(FileName, PrintPath, PrintItem)
Set fd = Nothing
Exit Function
ErrorHandler:
Set fd = Nothing
MsgBox "Error " & Err & ": " & Error(Err)
End Function
Function CopyFile(FullFileName, ToFolderName, PartID)
'' requires reference to Microsoft Scripting Runtime Library
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim td As DAO.TableDef
Dim fs As Scripting.FileSystemObject
Dim folder As Scripting.folder
Dim file As Scripting.file
Dim FileName As String
Dim FileFolder As String
Debug.Print
'On Error GoTo Err_Proc
Set db = CurrentDb()
Set fs = CreateObject("Scripting.FileSystemObject")
FileName = Mid(FullFileName, InStrRev(FullFileName, "\") + 1)
fs.CopyFile Source:=FullFileName, Destination:=ToFolderName
Forms!frmItemDetail!txtPrint = FileName
Forms!frmItemDetail!txtPrintPath = FullFileName
' Open recordset which will be used to add rows
' Set td = db.TableDefs!tblRefDocs
' Set td = db.TableDefs!tblTempItemDetails
' Set rs = td.OpenRecordset(dbOpenDynaset, dbSeeChanges)
' add to reference docs table
' rs.AddNew
' rs!PartID = PartID
' rs!Print = FileName
' rs!FolderName = FileFolder
' rs!UpdatedBy = Forms!frmLogin!txtNetworkID
' rs!UpdatedDT = Now()
' rs!LoggedDate = Now()
'
' rs.Update
End Function