Access VBA

[Guest]

How can I export a query to a specific spreadsheet on an excel file?

 

[Guest]

The non-automatic, old fasion way:
Run query and type
Ctrl+A
Ctrl+C
Go to Excel and type
Ctrl+V

 

[Guest]

If you want automation the first step will be to open a specific Excel file.
Try connect this VBA to a botton in a form, where Me!ExcelFil is a textbox
in the same form containing the path and filename:

Private Sub AabnPivotFrm_Click()
On Error GoTo AabnPivotFrm_Click_Err

Dim MyXL As Object

Set MyXL = CreateObject("Excel.Application")

MyXL.Workbooks.Open Me!ExcelFil
MyXL.Application.Visible = True
MyXL.Parent.Windows(1).Visible = True

AabnPivotFrm_Click_Exit:
Exit Sub

AabnPivotFrm_Click_Err:
MsgBox Err.Description
Resume AabnPivotFrm_Click_Exit

End Sub

Maybe you can the combine this with: SendKey

 

[Guest]

'put this code in a form event
Private Sub button_Click()
Dim sql as String
Dim rs as ADODB.Recordset
sql = "SELECT Drivers.* FROM Drivers WHERE Drivers.DriverId > 0;"
set rs = KeySet_Rs(sql)
ExportExcel "c:\excelfiles", "filename.xls", rs
rs.close
set rs = nothing

End Sub


'******************************************************************
'put this code below in a module

Global DatabasePassword = "user"
Global DatabaseUsername = "pass"
Global DatabaseName = "Database"
Global DatabaseServer = "Server"
'Connects to Mysql if mysql odbc 3.51 driver is installed

' to connect to mysql use this else use CurrentProject.Connection
Public Function Connect() As String
If IsNull(DatabaseUsername) Or IsNull(DatabasePassword) Or
IsNull(DatabaseName) Or IsNull(DatabaseServer) Then
GetDBInfoAll
ElseIf DatabaseUsername = "" Or DatabasePassword = "" Or DatabaseName =
"" Or DatabaseServer = "" Then
GetDBInfoAll
End If
Connect = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=" & DatabaseServer &
";" & _
"DATABASE=" & DatabaseName & ";UID=" & DatabaseUsername &
";PWD=" & EncryptDecrypt(DatabasePassword) & ";OPTION=35;"
End Function


' Returns Disconnected Keyset Recordset
Public Function KeySet_Rs(sql As String) As ADODB.recordset
Dim rs As ADODB.recordset
Set rs = New ADODB.recordset
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
rs.CursorType = adOpenKeyset
rs.Open sql, Connect()
rs.ActiveConnection = Nothing
Set KeySet_Rs = rs
End Function


'Exports a recordset to Excel
Public Sub ExportExcel(path As String, filename As String, rs As
ADODB.recordset)
Dim objXL As Object
Set objXL = CreateObject("Excel.Application")
objXL.Visible = False 'Set to true if you want to see it
objXL.Workbooks.Add 'creates new empty worksheet in excel

Dim row As Long, column As Long
column = 1
row = 1
With objXL.Application
Do While Not (rs.EOF Or rs.BOF)
If row = 1 Then
For column = 0 To rs.Fields.count - 1 'Get Header Row with
Field Names
.ActiveSheet.cells(row, column + 1).value =
rs.Fields(column).Name
.ActiveSheet.cells(row, column + 1).Borders.Weight =
xlMedium
.ActiveSheet.cells(row, column + 1).Interior.ColorIndex
= 15
.ActiveSheet.cells(row, column + 1).Interior.Pattern = 1
.ActiveSheet.cells(row, column +
1).Interior.PatternColorIndex = xlAutomatic
Next
row = row + 1
End If
For column = 0 To rs.Fields.count - 1 'Loop through
recordset and insert all the records into excel
Dim str As String
str = IIf(IsNull(rs.Fields(column)), "", rs.Fields(column))
If Len(str) > 0 Then
If IsDate(str) Then
.ActiveSheet.cells(row, column + 1).NumberFormat =
"mm/dd/yyyy hh:mm:ss AM/PM"
End If
End If
.ActiveSheet.cells(row, column + 1).value = rs.Fields(column)
.ActiveSheet.cells(row, column + 1).Borders.Weight = xlThin
Next
row = row + 1
rs.MoveNext
Loop
.ActiveSheet.Columns("A:ZZ").AutoFit
End With

If Not PathExists(path) Then
MkDir path
End If
objXL.ActiveWorkbook.SaveAs path & "\" & filename
objXL.Quit 'Remove this if you want to leave Excel Open
Set objXL = Nothing
End Sub