Export to Excel multiple files

gream0604

New member
Local time
Yesterday, 23:52
Joined
Oct 5, 2011
Messages
6
Hi all,

I am really stuck on this at the moment. I have an access database that sorts internet log files. I have a table called tblInternet. Within this table there are a number of fields. Date(field1), Time(field2), IP Address(field3), Website(field5), URL(field6) and Username(field4). What i would like to do is to be able to export the data from the table into seperate excel files. So that in the end i have an excel file for each user, with all their internet activity.

I have used some code that i found on this forum, and i have managed to get it to create a seperate file for each user, however none of the data in the file is filtered, and each file contains the data for all of the users?

Here is the code that im using. I really hope somebody can help me?

Code:
Private Sub Command18_Click()
DoCmd.OpenQuery "duplicates_query"

Dim strExcelFile As String
Dim strWorksheet As String
Dim strDB As String
Dim strTable As String
Dim objDB As Database

'Change Based on your needs, or use
'as parameters to the sub
strExcelFile = "c:\test.xls"
strWorksheet = "WorkSheet1"
strDB = "c:\database1.accdb"
strTable = "Internet"

Set objDB = OpenDatabase(strDB)

'If excel file already exists, you can delete it here
If Dir(strExcelFile) <> "" Then Kill strExcelFile

objDB.Execute _
"SELECT * INTO [Excel 8.0;DATABASE=" & strExcelFile & _
"].[" & strWorksheet & "] FROM " & "[" & strTable & "]"
objDB.Close
Set objDB = Nothing

Application.SetOption ("Auto Compact"), 1
              Application.SetOption "Show Status Bar", True
              vStatusBar = SysCmd(acSysCmdSetStatus, "The application must be compacted, please do not interfere with the Compacting process!")

End Sub

Private Sub Command20_Click()

Dim rst As DAO.Recordset
Dim Path As String
Dim StrDealer As String
Dim intDcode As String
Dim strQry As String
Dim StrExt As String
Dim strFile As String
Dim qDef As DAO.QueryDef

Err.Clear
On Error Resume Next
Set qDef = CurrentDb.QueryDefs("test_query")
On Error GoTo 0

strQry = "SELECT Internet.[Field1], Internet.[field2], Internet.[field3], Internet.[field4], Internet.[field5], Internet.[field6]FROM Internet"
Set rst = CurrentDb().OpenRecordset(strQry, dbOpenDynaset)

rst.MoveLast
rst.MoveFirst

Do While Not rst.EOF
Path = "C:\temp\"
StrDealer = rst("Field4")
strFile = Path & StrDealer
qDef.SQL = "SELECT * FROM Internet WHERE Field4 = field4"
DoCmd.OutputTo acOutputQuery, "test_query", acFormatXLS, strFile, False
rst.MoveNext
Loop

MsgBox ("Export Complete")
Set rst = Nothing
End Sub
 

Users who are viewing this thread

Back
Top Bottom