Hi Everyone, I have recently been tasked with taking over a bunch of Access databases that I didn't create. My VBA skills are weak to say the best but I have a particular problem I am working on. What I want to do is use a form to identify multiple value that will pass through a query and generate excel documents for a split field. I already have the code for that but I need to add a "column selection" tool to add or
Code:
delete particular columns based on customer requirements. I have attached my code below. What I want to do is use my checkboxed form to create unique queries. Any thoughts?
Option Compare Database
Private Sub btn_run_Click()
Dim Answer As String
Dim MyNote As String
Dim MyNote2 As String
Dim MyNote3 As String
Dim Complete As String
Dim Cancel As String
Dim Detail As String
MyNote = "This process will take about 15 minutes to complete. Would you like to proceed?"
MyNote2 = "Process complete. Thanks for your patience."
MyNote3 = "Process cancelled."
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Note")
'Detail = "C:\Users\jhasty\My Projects\File_Splitter\Files\*.*"
If Answer = vbNo Then
Cancel = MsgBox(MyNote3, vbInformation, "Process Cancelled")
Exit Sub
Else
' If Dir(Detail) = "" Then
' 'MsgBox "file does not exist"
' Else
' 'MsgBox "file does exist"
' Kill Detail
' End If
Dim db As Database
Dim carrier As Recordset
Dim setup As Recordset
Dim qd As QueryDef
Dim qd2 As QueryDef
Dim qdName As String
Dim sql_scacs As String
Dim sql_templates As String
Dim scac As String
Dim scac2 As String
Dim query As String
Dim template As String
Dim query_sql As String
Dim query_sql_replacement
Dim i As Integer
Dim count_records As Long
Dim templatecopy As String
Dim splitfield As String
Set db = CurrentDb()
'sql_scacs = "Select * from [qry_scacs]" 'where Active = -1"
sql_templates = "Select * from [tbl_setup_detail]" 'where active = -1"
Set setup = db.OpenRecordset(sql_templates)
'MsgBox sql_templates
sql_scacs = "SELECT " & setup("split_field") & " AS split FROM qry_pre_data GROUP BY " & setup("split_field") & " ORDER BY " & setup("split_field") & ";"
'MsgBox sql_scacs
Set carrier = db.OpenRecordset(sql_scacs)
templatecopy = setup("template") '"C:\Users\jhasty\My Projects\File_Splitter\Templates\Template - Copy.xls"
splitfield = setup("split_field")
i = 0
If Not carrier.EOF Then
carrier.MoveFirst
Do
scac = carrier("split")
'MsgBox scac
If Not setup.EOF Then
setup.MoveFirst
Do
query = setup("query")
For Each qd In db.QueryDefs
If qd.Name = query Then
query_sql = qd.SQL
query_sql_replacement = Replace(query_sql, "[ENTER SPLIT-VALUE FOR DETAIL]", "'" & scac & "'")
qdName = query & "_for_" & scac
For Each qd2 In db.QueryDefs
If qd2.Name = qdName Then
db.QueryDefs.Delete qdName
End If
Next
db.CreateQueryDef qdName, query_sql_replacement
End If
Next
template = "L:\Operations\Engineering\JH\Databases\File_Splitter\Output Files\" & scac & "-" & setup("filename")
'MsgBox template
'Kill template
FileCopy templatecopy, template
'template = setup("template")
'MsgBox query_sql_replacement
'MsgBox setup("template")
count_records = DCount("[SCAC]", qdName, "")
If (count_records > 0) Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, qdName, template, False, "data"
i = i + 1
Call update_excel_loop(template, i)
i = 0
End If
db.QueryDefs.Delete qdName
setup.MoveNext
Loop Until setup.EOF
setup.MoveFirst
End If
carrier.MoveNext
Loop Until carrier.EOF
End If
End If
Complete = MsgBox(MyNote2, vbInformation, "Process Complete")
End Sub
Private Sub update_excel_loop(template, i)
'declare variables
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
'excel application stuff
If i = 0 Then
Set xlApp = New Excel.Application
Else
Set xlApp = Excel.Application
End If
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Open(template)
'run the macro
xlApp.Run "Macro1"
'save file
'xlBook.Save
'done
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
Private Sub Detail_Click()
End Sub
Private Sub filename_AfterUpdate()
DoCmd.RunCommand acCmdSaveRecord
End Sub
Private Sub query_AfterUpdate()
DoCmd.RunCommand acCmdSaveRecord
End Sub
Private Sub splitfield_AfterUpdate()
DoCmd.RunCommand acCmdSaveRecord
End Sub
Private Sub template_AfterUpdate()
DoCmd.RunCommand acCmdSaveRecord
End Sub
Comment