Maven4Champ
Board Regular
- Joined
- Jun 10, 2004
- Messages
- 57
Ok,
After running a bunch of ideas through my head, here is what I want to do. I have created an AutoExec macro that runs a module upon opening the database (hense the autoexec name for the macro).
Most users are frightened by this and not sure whats going on right when they open the database. I am doing this to minimize steps. instead of going to the forms tag, opening the import form, importing, etc. I would like the dbase to open up and do it via the macro...
here is my thing. I need some sort of prompt to notify users right when they open the dbase...
here is my idea...
The macro is set to name: AutoExec with the following code it the module it runs:
Option Compare Database
Option Explicit
'FSO requires setting reference to "Microsoft Scripting Runtime".
'Module-Level Variables/Constants
Private fso As Scripting.FileSystemObject
'Change the following constants to the appropriate folder names
Const cstrAgentsPath As String = "S:\31630 Business Technology\Access-VB Projects\CentreVu\"
'Const cstrAgentsPath As String = "O:\Helpers\xxx\"
Sub ImportData()
Dim strFileName As String
Dim strDate As String
Dim rst As DAO.Recordset
Dim rstMain As DAO.Recordset
Dim dbs As DAO.Database
Dim strSql As String
Dim dDate As Date
Dim txtDate As String
UpdateFoundFiles
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("tblFilesFound")
Set rstMain = dbs.OpenRecordset("tblCentreVu", dbOpenSnapshot)
DoCmd.SetWarnings False
If rst.EOF = True And rst.BOF = True Then Exit Sub
rst.MoveFirst
While Not rst.EOF
txtDate = Left(rst!txtDate, 2) & "/" & Mid(rst!txtDate, 3, 2) & "/" & Right(rst!txtDate, 2)
dDate = CDate(txtDate)
If rstMain.EOF = True And rstMain.BOF = True Then ' no records in table
Call importFile(rst!txtpath, rst!txtAgent, dDate) ' append records not found
Else
rstMain.MoveLast
rstMain.FindFirst "((([Agent ID])='" & rst!txtAgent & "') AND (([Date])=#" & dDate & "#))"
If rstMain.NoMatch Then
Call importFile(rst!txtpath, rst!txtAgent, dDate) 'rst!txtDate) ' append records not found
End If
End If
rst.MoveNext
Wend 'rst
DoCmd.SetWarnings True
Set rst = Nothing
Set dbs = Nothing
End Sub
Sub importFile(strFileName As String, strAgent As String, dDate As Date) 'txtDate As String)
Dim strSql As String
DoCmd.SetWarnings False
DoCmd.OpenQuery ("qryDelTempData") ' clear table for new data
DoCmd.TransferText acImportDelim, "csvCimport", "tblImported", strFileName
' transferring data to main table
strSql = "INSERT INTO tblCentreVu ( [Agent ID], [Date], [From], [To], [Inbound ACD Calls], [Avg Inbound ACD Time], [Avg ACW Time (Inbound ACD)], [Outbound ACD Calls], [Avg Outbound ACD Time], [Avg ACW Time (Outbound ACD)], "
strSql = strSql & "[Extn In Calls], [Avg Extn In Time], [Extn Out Calls], [Avg Extn Out Time], [External Extn Out Calls], [Avg External Extn Out Time], Assists, [Trans Out] ) "
strSql = strSql & "SELECT '" & strAgent & "' AS Expr2, " ' fill Agents ID
strSql = strSql & "#" & dDate & "# AS Expr1, " ' fill date
strSql = strSql & "tblTimes.StartTime, tblTimes.EndTime, tblImported.[Inbound ACD Calls], tblImported.[Avg Inbound ACD Time], "
strSql = strSql & "tblImported.[Avg ACW Time (Inbound ACD)], tblImported.[Outbound ACD Calls], tblImported.[Avg Outbound ACD Time], "
strSql = strSql & "tblImported.[Avg ACW Time (Outbound ACD)], tblImported.[Extn In Calls], tblImported.[Avg Extn In Time], "
strSql = strSql & "tblImported.[Extn Out Calls], tblImported.[Avg Extn Out Time], tblImported.[External Extn Out Calls], tblImported.[Avg External Extn Out Time], "
strSql = strSql & "tblImported.Assists, tblImported.[Trans Out] "
strSql = strSql & "FROM tblImported INNER JOIN tblTimes ON tblImported.To = tblTimes.txtTime;"
DoCmd.RunSQL strSql
DoCmd.SetWarnings True
End Sub
'sub beginning process
Sub UpdateFoundFiles()
Dim FolderAgents As Scripting.Folder
Dim errorMes As Variant
On Error GoTo Link_Error
DoCmd.SetWarnings False
DoCmd.OpenQuery ("qryDelFoundFiles")
DoCmd.SetWarnings True
Set fso = CreateObject("Scripting.FileSystemObject")
Set FolderAgents = fso.GetFolder(cstrAgentsPath)
funFindAgents FolderAgents
Links_Exit:
Exit Sub
Link_Error: ' Error-handling routine.
Select Case Err.Number ' Evaluate error number.
Case 3109 ' no permision to delete records.
GoTo Links_Exit
Case Else
errorMes = MsgBox("Error Number " & Err.Number, vbCritical, "Code Error")
GoTo Links_Exit
End Select
End Sub
'Working sub
Private Sub funFindAgents(FolderAgents As Scripting.Folder)
Dim SubFolderAgents As Scripting.Folder
Dim oFile As Scripting.File
Dim strFile As String
Dim rst As DAO.Recordset
Dim dbs As DAO.Database
Dim agentID As String
Dim arrPath As Variant
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblFilesFound")
With rst
'For each subfolder in the main folder, run this sub recursively
If FolderAgents.SubFolders.Count Then
For Each SubFolderAgents In FolderAgents.SubFolders
funFindAgents SubFolderAgents
Next 'SubFolderAgents
End If
'scan folder for angent report files
For Each oFile In FolderAgents.Files
strFile = UCase$(oFile.Name)
If Right(strFile, 3) = "CSV" Then
arrPath = Split(UCase$(oFile.Path), "\") ' create an array from the path
agentID = arrPath(UBound(arrPath) - 1) ' pull agent ID
' add file here
.AddNew
!txtDate = Left(strFile, 6)
!txtAgent = agentID
!txtpath = oFile.Path
.Update
End If
Next 'oFile
.Close
End With
Set rst = Nothing
Set dbs = Nothing
End Sub
--------------
now, I would like a prompt to appear upon opening the dbase
Attention: Access is about to import all agent records into the CentreVu database. If you would like to Continue, Press Ok. If not, please press Cancel.
Then, if they hit cancel, it in essence stops the macro or disables it from running on start-up. If they hit OK, it executes the above AutoExec macro and runs the module code as shown above.
After it finishes, it returns the following msgbox: All data has successfully imported. Please press Finish. then the only button option they have is Finish..
is this possible or are their restraints in either VB or Access to not be able to do this?
After running a bunch of ideas through my head, here is what I want to do. I have created an AutoExec macro that runs a module upon opening the database (hense the autoexec name for the macro).
Most users are frightened by this and not sure whats going on right when they open the database. I am doing this to minimize steps. instead of going to the forms tag, opening the import form, importing, etc. I would like the dbase to open up and do it via the macro...
here is my thing. I need some sort of prompt to notify users right when they open the dbase...
here is my idea...
The macro is set to name: AutoExec with the following code it the module it runs:
Option Compare Database
Option Explicit
'FSO requires setting reference to "Microsoft Scripting Runtime".
'Module-Level Variables/Constants
Private fso As Scripting.FileSystemObject
'Change the following constants to the appropriate folder names
Const cstrAgentsPath As String = "S:\31630 Business Technology\Access-VB Projects\CentreVu\"
'Const cstrAgentsPath As String = "O:\Helpers\xxx\"
Sub ImportData()
Dim strFileName As String
Dim strDate As String
Dim rst As DAO.Recordset
Dim rstMain As DAO.Recordset
Dim dbs As DAO.Database
Dim strSql As String
Dim dDate As Date
Dim txtDate As String
UpdateFoundFiles
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("tblFilesFound")
Set rstMain = dbs.OpenRecordset("tblCentreVu", dbOpenSnapshot)
DoCmd.SetWarnings False
If rst.EOF = True And rst.BOF = True Then Exit Sub
rst.MoveFirst
While Not rst.EOF
txtDate = Left(rst!txtDate, 2) & "/" & Mid(rst!txtDate, 3, 2) & "/" & Right(rst!txtDate, 2)
dDate = CDate(txtDate)
If rstMain.EOF = True And rstMain.BOF = True Then ' no records in table
Call importFile(rst!txtpath, rst!txtAgent, dDate) ' append records not found
Else
rstMain.MoveLast
rstMain.FindFirst "((([Agent ID])='" & rst!txtAgent & "') AND (([Date])=#" & dDate & "#))"
If rstMain.NoMatch Then
Call importFile(rst!txtpath, rst!txtAgent, dDate) 'rst!txtDate) ' append records not found
End If
End If
rst.MoveNext
Wend 'rst
DoCmd.SetWarnings True
Set rst = Nothing
Set dbs = Nothing
End Sub
Sub importFile(strFileName As String, strAgent As String, dDate As Date) 'txtDate As String)
Dim strSql As String
DoCmd.SetWarnings False
DoCmd.OpenQuery ("qryDelTempData") ' clear table for new data
DoCmd.TransferText acImportDelim, "csvCimport", "tblImported", strFileName
' transferring data to main table
strSql = "INSERT INTO tblCentreVu ( [Agent ID], [Date], [From], [To], [Inbound ACD Calls], [Avg Inbound ACD Time], [Avg ACW Time (Inbound ACD)], [Outbound ACD Calls], [Avg Outbound ACD Time], [Avg ACW Time (Outbound ACD)], "
strSql = strSql & "[Extn In Calls], [Avg Extn In Time], [Extn Out Calls], [Avg Extn Out Time], [External Extn Out Calls], [Avg External Extn Out Time], Assists, [Trans Out] ) "
strSql = strSql & "SELECT '" & strAgent & "' AS Expr2, " ' fill Agents ID
strSql = strSql & "#" & dDate & "# AS Expr1, " ' fill date
strSql = strSql & "tblTimes.StartTime, tblTimes.EndTime, tblImported.[Inbound ACD Calls], tblImported.[Avg Inbound ACD Time], "
strSql = strSql & "tblImported.[Avg ACW Time (Inbound ACD)], tblImported.[Outbound ACD Calls], tblImported.[Avg Outbound ACD Time], "
strSql = strSql & "tblImported.[Avg ACW Time (Outbound ACD)], tblImported.[Extn In Calls], tblImported.[Avg Extn In Time], "
strSql = strSql & "tblImported.[Extn Out Calls], tblImported.[Avg Extn Out Time], tblImported.[External Extn Out Calls], tblImported.[Avg External Extn Out Time], "
strSql = strSql & "tblImported.Assists, tblImported.[Trans Out] "
strSql = strSql & "FROM tblImported INNER JOIN tblTimes ON tblImported.To = tblTimes.txtTime;"
DoCmd.RunSQL strSql
DoCmd.SetWarnings True
End Sub
'sub beginning process
Sub UpdateFoundFiles()
Dim FolderAgents As Scripting.Folder
Dim errorMes As Variant
On Error GoTo Link_Error
DoCmd.SetWarnings False
DoCmd.OpenQuery ("qryDelFoundFiles")
DoCmd.SetWarnings True
Set fso = CreateObject("Scripting.FileSystemObject")
Set FolderAgents = fso.GetFolder(cstrAgentsPath)
funFindAgents FolderAgents
Links_Exit:
Exit Sub
Link_Error: ' Error-handling routine.
Select Case Err.Number ' Evaluate error number.
Case 3109 ' no permision to delete records.
GoTo Links_Exit
Case Else
errorMes = MsgBox("Error Number " & Err.Number, vbCritical, "Code Error")
GoTo Links_Exit
End Select
End Sub
'Working sub
Private Sub funFindAgents(FolderAgents As Scripting.Folder)
Dim SubFolderAgents As Scripting.Folder
Dim oFile As Scripting.File
Dim strFile As String
Dim rst As DAO.Recordset
Dim dbs As DAO.Database
Dim agentID As String
Dim arrPath As Variant
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblFilesFound")
With rst
'For each subfolder in the main folder, run this sub recursively
If FolderAgents.SubFolders.Count Then
For Each SubFolderAgents In FolderAgents.SubFolders
funFindAgents SubFolderAgents
Next 'SubFolderAgents
End If
'scan folder for angent report files
For Each oFile In FolderAgents.Files
strFile = UCase$(oFile.Name)
If Right(strFile, 3) = "CSV" Then
arrPath = Split(UCase$(oFile.Path), "\") ' create an array from the path
agentID = arrPath(UBound(arrPath) - 1) ' pull agent ID
' add file here
.AddNew
!txtDate = Left(strFile, 6)
!txtAgent = agentID
!txtpath = oFile.Path
.Update
End If
Next 'oFile
.Close
End With
Set rst = Nothing
Set dbs = Nothing
End Sub
--------------
now, I would like a prompt to appear upon opening the dbase
Attention: Access is about to import all agent records into the CentreVu database. If you would like to Continue, Press Ok. If not, please press Cancel.
Then, if they hit cancel, it in essence stops the macro or disables it from running on start-up. If they hit OK, it executes the above AutoExec macro and runs the module code as shown above.
After it finishes, it returns the following msgbox: All data has successfully imported. Please press Finish. then the only button option they have is Finish..
is this possible or are their restraints in either VB or Access to not be able to do this?