joshandsony
Registered User.
- Local time
- Today, 06:02
- Joined
- Feb 19, 2009
- Messages
- 59
Hello All. I am not very good at this whole VB thing, so please bear with me. The code I have listed below I am trying to run off my switchboard. I have tried calling the code through a button that I have placed on the switchboard, and I have also tried making a "run code" macro and neither seem to work. Can someone please point me in the right direction?
Public Sub MultiQueryExportToExcel( _
ByVal sFilename As String, _
ParamArray arrQueryName() As Variant)
Dim objExcelApp As Object
Dim objExcelBook As Object
Dim objExcelSheet As Object
Dim rs As ADODB.Recordset
Dim vQueryName As Variant
Dim X As Long
If UBound(arrQueryName) = -1 Then Exit Sub
Set objExcelApp = CreateObject("Excel.Application")
Set objExcelBook = objExcelApp.Workbooks.Add
With objExcelBook
For Each vQueryName In arrQueryName
Set rs = New ADODB.Recordset
rs.Open vQueryName, CurrentProject.Connection
Set objExcelSheet = .Worksheets.Add(, _
.Worksheets(.Worksheets.Count))
For X = 0 To rs.Fields.Count - 1
objExcelSheet.Cells(1, X + 1) = rs.Fields(X).Name
Next X
objExcelSheet.Range("A2").CopyFromRecordset rs
objExcelSheet.Name = vQueryName
rs.Close
Set rs = Nothing
Next vQueryName
Set objExcelSheet = Nothing
Do While .Sheets.Count > UBound(arrQueryName) + 1
.Sheets(1).Delete
Loop
.SaveAs sFilename
End With
Set objExcelBook = Nothing
objExcelApp.Quit
Set objExcelApp = Nothing
End Sub

Public Sub MultiQueryExportToExcel( _
ByVal sFilename As String, _
ParamArray arrQueryName() As Variant)
Dim objExcelApp As Object
Dim objExcelBook As Object
Dim objExcelSheet As Object
Dim rs As ADODB.Recordset
Dim vQueryName As Variant
Dim X As Long
If UBound(arrQueryName) = -1 Then Exit Sub
Set objExcelApp = CreateObject("Excel.Application")
Set objExcelBook = objExcelApp.Workbooks.Add
With objExcelBook
For Each vQueryName In arrQueryName
Set rs = New ADODB.Recordset
rs.Open vQueryName, CurrentProject.Connection
Set objExcelSheet = .Worksheets.Add(, _
.Worksheets(.Worksheets.Count))
For X = 0 To rs.Fields.Count - 1
objExcelSheet.Cells(1, X + 1) = rs.Fields(X).Name
Next X
objExcelSheet.Range("A2").CopyFromRecordset rs
objExcelSheet.Name = vQueryName
rs.Close
Set rs = Nothing
Next vQueryName
Set objExcelSheet = Nothing
Do While .Sheets.Count > UBound(arrQueryName) + 1
.Sheets(1).Delete
Loop
.SaveAs sFilename
End With
Set objExcelBook = Nothing
objExcelApp.Quit
Set objExcelApp = Nothing
End Sub