Hello All!
Im having a compile issue and I don't know why, I'm ok with VBA but not a pro, I need a helping hand to see why I'm getting a compile error I'll post the code here maybe someone can tell me where i messed up. the bold red letter gives me the compile error and don't know why.Thanks in advance.
Function BackUpDb()
On Error GoTo Err_BackUpDb
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim fso As FileSystemObject
Dim sSourcePath As String
Dim sBackupPath As String
Dim sBackupFile As String
Dim strFileName As String
Dim sBackupFolder As String
Dim sFilePart As String
Dim sFileExtension As String
Set db = CurrentDb()
Screen.MousePointer = 11
strFileName = Forms!frmBackUp.BackUpFrom
sSourcePath = strFileName
'Establish the file name to allow the same name to be used
sFilePart = ParseFileName(sSourcePath, 2)
'Establish the extension and make the copy the same. (*.mdb stays *.mdb,*.mde stays *.mde etc)
sFileExtension = ParseFileName(sSourcePath, 3)
sBackupFolder = Forms!frmBackUp.BackUpTo
sBackupPath = sBackupFolder & "\"
sBackupFile = sFilePart & "_" & Format(Date, "dd-mm-yyyy") & "-" & Format(Time, "hh-mmAMPM") & sFileExtension
Call LoadData("Backing Up Database file ............")
Set fso = New FileSystemObject
fso.CopyFile sSourcePath, sBackupPath & sBackupFile, True
Set fso = Nothing
Set rst = db.OpenRecordset("tblBackUpFile", dbOpenDynaset)
rst.Edit
rst!RestorePath = sBackupPath & sBackupFile
rst!RestoreDate = Now()
rst.Update
rst.close
If IsLoaded("frmBackUp") Then
Forms!frmBackUp.Requery
End If
Pause 2
Screen.MousePointer = 0
DoCmd.close acForm, "frmLoading"
MsgBox "Backup Complete. Backup file is located at: " & Chr(13) & sBackupPath & sBackupFile, vbInformation, " ASSETSonTRACK"
Exit_BackUpDb:
Exit Function
Err_BackUpDb:
DoCmd.close acForm, "frmLoading"
Screen.MousePointer = 0
MsgBox Err.Description, , " Predator Software Backup Utility"
Resume Exit_BackUpDb
End Function
Code#2
Private Sub btnSaveCSV_Click()
'Save the source table or query for report as .csv file
Dim vPath As String, vFilter As String, vReportPath As String
On Error GoTo ErrorCode
'Set default file location as C:\ and open SaveAs dialog box for user to save file
vFilter = ahtAddFilterItem(vFilter, "All Files (*.*)", "*.*") 'define filter string (ALL)
vFilter = ahtAddFilterItem(vFilter, "CSV Files (*.csv)", "*.csv") 'define filter string (csv)
vReportPath = Nz(DLookup("CSVFolder", "tblAdmin"), "C:") 'fetch default reports folder
vPath = ahtCommonFileOpenSave(4108, vReportPath, vFilter, 2, ".csv", Me.lstReports.Column(4) & ".csv", "Save Report as .csv", , False) 'open SaveAs file selector
If vPath = "" Then Exit Sub 'exit if user cancels save operation
vReportPath = Left(vPath, InStrRev(vPath, "\")) 'extract pathname
CurrentDb.Execute "UPDATE tblAdmin SET CSVFolder = '" & vReportPath & "'" 'save new pathname to ReportsFolder field
If Dir(vPath) <> "" Then
If MsgBox("WARNING. The report - (" & vPath & ") already exists, do you want to overwrite this file?", vbQuestion + vbYesNo, "Overwrite Confirmation") = vbNo Then Exit Sub
End If
DoEvents
DoCmd.Hourglass True
DoCmd.TransferText acExportDelim, , Me.lstReports.Column(6), vPath, True 'export query as .csv file to disk
DoCmd.Hourglass False
MsgBox "Report saved as " & vPath & ".", vbInformation + vbOKOnly, "Report Saved as .csv File"
Exit Sub
ErrorCode:
DoCmd.Hourglass False
If Err = 2501 Then Exit Sub 'ignore error if user cancels print
Beep
MsgBox Err.Description
End Sub