I added the above code to my form, just below my Commond Button to get files. How do I trigger your code to do its thing
I created a button called cmdImportFiles
*******Old but works code*******************************
Private Sub cmdFileOpen_Click()
' Test the CommonDlg class' FileOpen common dialog.
Dim cdl As CommonDlg
Set cdl = New CommonDlg
cdl.hWndOwner = Me.hWnd
cdl.CancelError = True
On Error GoTo HandleErrors
' Set three pairs of values for the Filter.
cdl.Filter = _
"Adobe Acrobat Document (*.pdf)|" & _
"*.pdf|" & _
"Database files (*.mdb, *.mde, *.mda)|" & _
"*.mdb;*.mde;*.mda|" & _
"All files (*.*)|" & _
"*.*"
' Select filter 1 (DataShete files) when
' the dialog opens.
cdl.FilterIndex = 1
' Indicate that you want to use a callback function,
' change back to the original directory when
' you're done, and require that the selected
' file actually exist.
cdl.OpenFlags = cdlOFNEnableHook Or _
cdlOFNNoChangeDir Or cdlOFNFileMustExist
' Select the callback function.
cdl.CallBack = adhFnPtrToLong(AddressOf GFNCallback)
' Set up miscellaneous properties.
cdl.InitDir = "C:\"
cdl.FileName = "autoexec.pdf"
cdl.DefaultExt = "pdf"
' Open the file open dialog box,
' and wait for it to be dismissed.
cdl.ShowOpen
' Retrieve the selected file na
txtFileOpen = cdl.FileName
' Check the OpenFlags (or Flags) property to
' see if the selected extension is different than
' the default extension.
If (cdl.OpenFlags And _
cdlOFNExtensionDifferent) <> 0 Then
MsgBox "You chose a different extension!"
End If
ExitHere:
Set cdl = Nothing
Exit Sub
HandleErrors:
Select Case Err.Number
Case cdlCancel
' Cancelled!
Resume ExitHere
Case Else
MsgBox "Error: " & Err.Description & _
"(" & Err.Number & "
"
End Select
Resume ExitHere
End Sub
''''''''''''''NewCode'''''''''''''''''''''''''''''''''''
Function moveAndCopyFile()
'Function moveAndCopyFile() finds the appropriate file, moves it to a new folder to with
'the current date and then creates a copy that is in .txt format to be imported into the
'database, it then calls the import file function to finalize the process and import the files
Dim fso As FileSystemObject
'files to transfer and import, if the file names or locations ever change they will need
'to be changed here
Dim file1, file2, file3, file4 As String
file1 = "W:\Corp\ACCT\900020\APPS\VNDERR\rgmmch.dat"
file2 = "W:\Corp\ACCT\900020\APPS\VNDERR\rgmmus.dat"
file3 = "W:\Corp\ACCT\900020\APPS\VNDERR\vcbmch.dat"
file4 = "W:\Corp\ACCT\900020\APPS\VNDERR\vcbmus.dat"
Set fso = CreateObject("Scripting.FileSystemObject"
'Verify files exist
If Not fso.FileExists(file1) Then
MsgBox "Files are not there, please verify they are there and try another time.", _
vbInformation, "File Not Found"
Exit Function
ElseIf Not fso.FileExists(file2) Then
MsgBox "Files are not there, please verify they are there and try another time.", _
vbInformation, "File Not Found"
Exit Function
ElseIf Not fso.FileExists(file3) Then
MsgBox "Files are not there, please verify they are there and try another time.", _
vbInformation, "File Not Found"
Exit Function
ElseIf Not fso.FileExists(file4) Then
MsgBox "Files are not there, please verify they are there and try another time.", _
vbInformation, "File Not Found"
Exit Function
Else
'Files exist, create folder with the current date
Dim fsoFolder
Dim fol As String
fol = "V:\Corp\ACCT\900220\CC\Post Audit\Download Info\VCB RGM Detail\" _
& Format(Now, "yyyy-mm-dd"
Set fsoFolder = CreateObject("Scripting.FileSystemObject"
'create folder only if it doesn't already exist
If Not fso.FolderExists(fol) Then
fsoFolder.CreateFolder (fol)
Else
MsgBox fol & " already exists, this process has already been done!", _
vbExclamation, "Folder Exists"
Exit Function
End If
'move the files into the newly created folder and make a copy in .txt format
fso.MoveFile file1, fol & "\" & Right(file1, 10)
fso.CopyFile fol & "\" & Right(file1, 10), fol & "\" & "rgmmch.txt"
fso.MoveFile file2, fol & "\" & Right(file2, 10)
fso.CopyFile fol & "\" & Right(file2, 10), fol & "\" & "rgmmus.txt"
fso.MoveFile file3, fol & "\" & Right(file3, 10)
fso.CopyFile fol & "\" & Right(file3, 10), fol & "\" & "vcbmch.txt"
fso.MoveFile file4, fol & "\" & Right(file4, 10)
fso.CopyFile fol & "\" & Right(file4, 10), fol & "\" & "vcbmus.txt"
End If
'call function to do the import portion
ImportFiles
'delete the .txt files that were created and keep the original .dat files
fso.DeleteFile fol & "\" & "rgmmch.txt"
fso.DeleteFile fol & "\" & "rgmmus.txt"
fso.DeleteFile fol & "\" & "vcbmch.txt"
fso.DeleteFile fol & "\" & "vcbmus.txt"
'log successful import process
logUserAccess
'all processes have completed successfully, notify the user
MsgBox "File Copy and Import Complete", vbInformation, "Process Complete"
End Sub
Private Sub cmdImportFiles_Click()
'how do I trigger the above events?
End Sub
