Export To From Access 03 to Excel using VBA

[MarcusMaximus]

Hi I have a database with many staff members and each staff member has many Customers assigned to them. I want to export customer details to a separate excel file for each staff member. I don't want to have to do this manually as its going to take up time. I'd like to name the files according to the staff number also if possible.

I don't know how I can do this in Access. Do I write a module or a macro or something. I wrote a macro previous for something similar where i created 50 individual queries for each member of staff and used the TransferSpreadsheet function in a macro but this was too laborious.

I found this in the code repository but it's not quiet what im looking for.

Any Ideas.
Thanks

 

[chergh]

Wow not heard of anyone wanting to do that before. Try this

 

[chergh]

You also don't say why the code you found in the repository wasn't quite what you were looking for.

 

[MSAccessRookie]

I do not think that your needs require such a detailed resolution. The following could be another approach:

• Create a Query to get the complete list of Staff members involved Including their name and ID Number.
• Create a Query that is based on the First Query, and collects the information that is necessary for your Excel Spreadsheet.
• Create a VBA procedure that uses the results of the First Query in a Loop Statement, and a DoCmd.TransferSpreadsheet Function that exports the results of the Second Query to an Excel Spreadsheet with a name that is created using the Name and ID Number collected in the First Query.

Try this and post back if you have further questions.

 

[MarcusMaximus]

You also don't say why the code you found in the repository wasn't quite what you were looking for.

I don't want to copy tables to separate worksheets. I have one table and i want to export multiple excel spread sheets based on the userid field. MSAccessRookie has the right idea but I'm not very familiar with VBA.

I do not think that your needs require such a detailed resolution. The following could be another approach:

• Create a Query to get the complete list of Staff members involved Including their name and ID Number.

Select Distinct UserID from tblcustomers
What do i do with this query so i can traverse through it for the next query.
Do i put it as Dim result1 = DBQuery(Select Distinct UserID from tblcustomers)

• Create a Query that is based on the First Query, and collects the information that is necessary for your Excel Spreadsheet.

Not to sure how to do this in VBA as I'm not sure how to do the previous bit properly.
Select * from tblcustomers where userid = "result1.userid"

• Create a VBA procedure that uses the results of the First Query in a Loop Statement, and a DoCmd.TransferSpreadsheet Function that exports the results of the Second Query to an Excel Spreadsheet with a name that is created using the Name and ID Number collected in the First Query.

Try this and post back if you have further questions.

Stuck on this bit too as I'm not familiar with VBA.

Public Function ExportFiles()
result1 = select distinct userid from tblcustomers
For Each result1 
result2 Select * from tblcustomers where userid = result1.userid
           for each result2
                 DoCmd.TransferSpreadsheet result2
           End for
End for
End Function

I don't want ye to feel like ye're doing it for me but i don't have much experience with VBA.
I can do it in php but unfortunately not VBA, excluding the export to excel function.

<?php
    $result = DBQuery("SELECT distinct UserID FROM tblcustomers");
        
    while ( $u = mysql_fetch_array( $result ) ) {
        $r2 = DBQuery("SELECT * FROM tblcustomers WHERE user_id=".$u['UserID']);
   
        while( $cus = mysql_fetch_Array( $r2 ) ) {
           
                 /*Here's Where I'd stick in the export to excel function*/
                 /*DoCmd.TransferSpreadsheet $cus*/
        }
    }
?>

Any help would be much appreciated.

 

[MarcusMaximus]

Here's what I've come up with

Public Function ExportFiles()

    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset

    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.Open "SELECT DISTINCT tblcustomer.userid FROM tblcustomer"
    
    While Not rst.EOF
        strquery = "Select * from tblcustomer where userid =" & [rst]![USERID] & ";"
        
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                strquery, "W:\Folder\Sub\sub\" & [rst]![USERID] & ".xls"
    
        rst.MoveNext
    
    Wend
    
End Function

I try to run this code from a macro.
I get a runtime error 3265 and when i debug its at strquery = "Select * from tblcustomer where userid =" & [rst]![USERID] & ";"

 

[chergh]

Here's what I've come up with

Public Function ExportFiles()

    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset

    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.Open "SELECT DISTINCT tblcustomer.userid FROM tblcustomer"
    
    While Not rst.EOF
        strquery = "Select * from tblcustomer where userid =" & [rst]![USERID] & ";"
        
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                strquery, "W:\Folder\Sub\sub\" & [rst]![USERID] & ".xls"
    
        rst.MoveNext
    
    Wend
    
End Function

I try to run this code from a macro.
I get a runtime error 3265 and when i debug its at strquery = "Select * from tblcustomer where userid =" & [rst]![USERID] & ";"

That looks the right sort of thing. I'm guessing userID is a string and not a numeric value try:

strquery = "Select * from tblcustomer where userid = '" &  rst!USERID & "';"

I've inserted apostrophes round your userid value

 

[MarcusMaximus]

    Public Function ExportFiles()

    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset

    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.Open "SELECT DISTINCT tblcustomer.userid FROM tblcustomer"
    
    While Not rst.EOF
        Dim strquery As String
        strquery = "Select * from tblcustomer where userid = '" &   rst!USERID & "';"
           
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                strquery, "W:\Folder\sub\sub\" & rst![USERID] & ".xls"
    
        rst.MoveNext
    
    Wend
    
End Function

Thanks chergh, userid is a string i changed the query to match yours and i get:

Runtime error 3011

The microsoft jet database engine could not find the object 'Select * from tblcustomers where userid ='002';'.Make sure the object exists and you spelt its name and the path correctly.

I changed the code slightly before your response to include Dim strquery As String. I don't think this would cause an issue as tried running without and got the same issue.

When i select debug it takes me to the DoCmd.TransferSpreadsheet section. Do i have to correct syntax for that. Or is there something else missing.

 

[chergh]

I don't think you can use a sql statement in the transferspreadsheet method, I never use transferspreadsheet myself so I'm not 100% sure. Instead you actually have to create a query object in the db and use that.

If your lucky someone else more familiar with this method will jump in with some help or if they don't I will reply back with a solution when I have a chance to have a look.

 

[MarcusMaximus]

Thanks chergh, but I'm probably going to have to do it manually unless i can find a work around. Maybe create a table and export that table to an excel file and then delete that table. And work my way through the record set.

 

[MarcusMaximus]

Thanks for the Help people.

I had one last throw at the dice and it didn't work so I'm going home for the evening and will do it manually tomorrow instead, unless somebody can offer me some insight into why my new or old technique won't work.

In the new technique i write to the Temptable and also prints what i and writing to the immediate window, it gives no errors and finishs running the code with no erros but doesn't export to the excel files, eith by creating the files before hand or leaving the TransferSpreadsheet create it.

Public Function ExportFiles()

    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset

    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.Open "SELECT DISTINCT tblcustomer.UserID FROM tblcustomer"
    
    While Not rst.EOF
        Dim path As String
        path = "W:\Folder\sub\ExcelFiles\" & rst!UserID & ".xls"
         
        Dim rst2 As ADODB.Recordset
        Set rst2 = New ADODB.Recordset

        rst2.ActiveConnection = CurrentProject.Connection
        rst2.CursorType = adOpenStatic
        rst2.Open "Select * from tblcustomer where UserID = '" & rst![UserID] & "';"
         
        While Not rst2.EOF
            'Debug.Print path
            Debug.Print rst2!ID & "', '" & rst2!UserID & "', '" & rst2!CustID & "', '" & rst2!CustContact & "', '" & rst2!CUST_NAME & "', '" & rst2!ADDRESS1 & "', '" & rst2!ADDRESS2 & "', '" & rst2!ADDRESS3 & "', '" & rst2!Address4 & "', '" & rst2!TOWNLAND & "', '" & rst2!CITY_COUNT & "', '" & rst2!TELEPHONE & "', '" & rst2!FAX & "', '" & rst2!Mobile & "', '" & rst2!EMAIL
                     
            Dim InsetSQL As String
            InsertSQL = "Insert INTO TempTable (ID, UserID, CustID, CustContact, CUST_NAME, ADDRESS1,    ADDRESS2,    ADDRESS3,    Address4,    TOWNLAND,    CITY_COUNT,  TELEPHONE,   FAX, Mobile,  EMAIL) values ('" & rst2!ID & "', '" & rst2!UserID & "', '" & rst2!CustID & "', '" & rst2!CustContact & "', '" & rst2!CUST_NAME & "', '" & rst2!ADDRESS1 & "', '" & rst2!ADDRESS2 & "', '" & rst2!ADDRESS3 & "', '" & rst2!Address4 & "', '" & rst2!TOWNLAND & "', '" & rst2!CITY_COUNT & "', '" & rst2!TELEPHONE & "', '" & rst2!FAX & "', '" & rst2!Mobile & "', '" & rst2!EMAIL & "');"
            
            CurrentDb.Execute InsertSQL
            
            rst2.MoveNext
                 
        Wend
        
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
            "TempTable", "path"

        CurrentDb.Execute "DELETE TempTable.* FROM TempTable"
                        
        rst.MoveNext
    
    Wend
    
End Function

Thanks again.

 

[chergh]

If we don't rely on transferspreadsheet and use copyfromrecordset instead this is easier, and for someone who doesn't know vba you've got the hang of it fast.

Public Function ExportFiles()

    Dim rst As ADODB.Recordset
    Dim rst2 As ADODB.Recordset
    
    Set rst = New ADODB.Recordset
    Set rst2 = New ADODB.Recordset
    
    Dim xlApp As Object 'excel application object
    Dim wb As Object ' excel workbook object
    
    Dim path As String
    
    
    Set xlApp = CreateObject("Excel.Application")
    

    
    Set rst2 = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.Open "SELECT DISTINCT tblcustomer.UserID FROM tblcustomer"
    
    Do Until rst.EOF
    
        Set wb = xlApp.Workbooks.Add


         
        path = "W:\Ford2010\Fleet\ExcelFiles\" & rst!userID & ".xls"
        wb.SaveAs path

        Set rst2 = New ADODB.Recordset

        rst2.ActiveConnection = CurrentProject.Connection
        rst2.CursorType = adOpenStatic
        rst2.Open "Select * from tblcustomer where UserID = '" & rst![userID] & "';"
         
        For i = 0 To rst2.Fields.Count - 1
            
            wb.Worksheets("sheet1").Cells(1, i + 1).Value = rst2.Fields(i).Name
        
        Next i

        wb.Worksheets("sheet1").Range("A2").CopyFromRecordset rst2
        
        rst2.Close
        
        Set rst2 = Nothing
        
        wb.Close True
        
        Set wb = Nothing
                        
        rst.MoveNext
            
    Loop
    
End Function

 

[MarcusMaximus]

If we don't rely on transferspreadsheet and use copyfromrecordset instead this is easier, and for someone who doesn't know vba you've got the hang of it fast.

Public Function ExportFiles()

    Dim rst As ADODB.Recordset
    Dim rst2 As ADODB.Recordset
    
    Set rst = New ADODB.Recordset
    Set rst2 = New ADODB.Recordset
    
    Dim xlApp As Object 'excel application object
    Dim wb As Object ' excel workbook object
    
    Dim path As String
    
    
    Set xlApp = CreateObject("Excel.Application")
    

    
    Set rst2 = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.Open "SELECT DISTINCT tblcustomer.UserID FROM tblcustomer"
    
    Do Until rst.EOF
    
        Set wb = xlApp.Workbooks.Add
       
        path = "W:\Folder\sub\ExcelFiles\" & rst!userID & ".xls"
        wb.SaveAs path

        Set rst2 = New ADODB.Recordset

        rst2.ActiveConnection = CurrentProject.Connection
        rst2.CursorType = adOpenStatic
        rst2.Open "Select * from tblcustomer where UserID = '" & rst![userID] & "';"
         
        For i = 0 To rst2.Fields.Count - 1
            
            wb.Worksheets("sheet1").Cells(1, i + 1).Value = rst2.Fields(i).Name
        
        Next i

        wb.Worksheets("sheet1").Range("A2").CopyFromRecordset rst2
        
        rst2.Close
        
        Set rst2 = Nothing
        
        wb.Close True
        
        Set wb = Nothing
                        
        rst.MoveNext
            
    Loop
    
End Function

Thanks chergh, your code worked a treat. I'm only getting the hang of vba from learning from people like yourself. At that I wouldn't have been able to come up with that fine piece of code.

 

[Steve5]

How would it look if you had two queries and you wanted to export Query 1 into sheet1 and Query 2 into sheet2 of same workbook?

Is this possible?

 

[MarcusMaximus]

I'd imagine you'd just create a second record set and use the same 'Do While' function to traverse through it and use sheet 2 instead of sheet one. Cherge may be able to give you more info or give it a go yourself.

 

[gemma-the-husky]

i would do this

create a query of the cutomers, with a parameter selecting for a particular admin clerk

then you can do this code framework

open clerks record set
while not eof
  store active clerk
  export customer data file based on active clerk
  next clerk
wend