Export/writing Access 2016 tables to many excel spreadsheets

Question

  I have been trying to find some vba code to help me create a script to export a couple of related tables into several Excel spreadsheets.  Very tricky to do (for me anyways) in vba.  I have 2 tables and they are related.  It is that I have approx. 400 columns of data, so I split it into 2 tables.  I know this is not the best approach, but the user kicked and screamed, so I built things the wanted he wanted in a spreadsheet format, with a ton of redundant data.  I already know and understand normalization, but he pays the bill.  Anyways, here is what I am trying to do.  Each spreadsheet name, needs to be data from some of the columns.  i.e. Dlrname_Year_Make_Model_1.xls  and Dlrname_Year_Make_Model_2.xls.  Each of these are columns in the table.  As I read each row from table_1, I write to excel_1, then I get a row fro table_2 and write to excel_2.  When any of these values change, then I close the current excel sheets and open a new ones.  Then I also need to ensure that if the Dlrname changes, that I change the folder location for where I am going to write the files.  Very very challenging and any direction on doing this would be greatly appreciated.  Thanx in advance.

Answer 1

Please use precise language. It seems you conflagrate "spreadsheet" and "workbook". An Excel file is a workbook, and each workbook has one or more sheets.

It seems that in your case you have one sheet per workbook, correct?
Do these workbooks already exist, or do they need to be created?
Are you writing only 1 row of data to each workbook?
"When any of these values change": what do you mean? In any of the 400 columns? I would guess that each row has different data, is that not so?
With "Dlrname" do you mean DirName - the name of the directory to save to?

Maybe you can illustrate with some screenshots or mock data.

---

-Tom. Microsoft Access MVP

Answer 2

Sure.  To address your questions:

It seems that in your case you have one sheet per workbook, correct?  Yes, this is true

Do these workbooks already exist, or do they need to be created?  They do not exist.  They should be created each time I run the program.

Are you writing only 1 row of data to each workbook?  NO.

"When any of these values change": what do you mean? In any of the 400 columns? I would guess that each row has different data, is that not so?  NO.  What I mean is any of the 'key' data changes, which includes Dealer_Name, Year_Car, Make_Car & Model_Car

With "Dlrname" do you mean DirName - the name of the directory to save to?  NO.  I should say Dealer_Name.

Maybe you can illustrate with some screenshots or mock data.

  Rows 1-5 has  Dealer_Name: = 123, Year_Car = 2018, Make_Car = Acura, Model_Car = ILX.  I want to write these records to an excel workbook (5 rows) that is named Dealer_Name+Year_Car+Make_Car+Model_Car into a folder with the Dealer_Name.

  Rows 6-7 has  Dealer_Name: = 123, Year_Car = 2018, Make_Car = Acura, Model_Car = MDX  I want to write these records to an excel workbook (2 rows) that is named Dealer_Name+Year_Car+Make_Car+Model_Car into a folder with the Dealer_Name.  Since the Model_Car changed, I want to write it's content into a different Excel workbook than the one listed prior.

 Rows 8-15 has  Dealer_Name: = 456, Year_Car = 2018, Make_Car = Acura, Model_Car = ILX.  I want to write these records to an excel workbook (8 rows) that is named Dealer_Name+Year_Car+Make_Car+Model_Car into a folder with the Dealer_Name.  Now since the Dealer_Name has changed, I want to start saving/writing the information into a different folder from folder Dealer_Name = 123.  I should now be saving data to a folder where Dealer_Name = 456.

  The Dealer_Name form the table is a variable for the folder name and the beginning of the excel file name.  The Year_Car, Make_Car & Model_Car come from the table and are used to create the rest of the excel file name.  As listed above.

  I hope this helps in clarifying what I am trying to figure out how to do and have someone direct me on how I could do all of this!  Thanx in advance, I really appreciate it!

Answer 3

Thanks for your answers. This all makes logical sense to me.
You already know you'll need to use Excel automation - TransferSpreadsheet is not powerful enough.
So start writing a few functions, for example CreateWorkbook, CopyRecordset, and others.
Look at Excel's CopyFromRecordset function - I think I would use that.

Processing the data and deciding when it's time to start a new file seems the easy part but let me know if you need help with that.

We're not going to write the entire code for you, but if you have specific questions, let's hear it.

---

-Tom. Microsoft Access MVP

Answer 4

Hello ballj_351,

Has your original issue been resolved? If it has, I would suggest you mark the helpful reply as answer or provide your solution and mark as answer to close this thread. If not, please feel free to let us know your current issue.

Best Regards,

Terry

---

MSDN Community Support
Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact [e-mail].

Answer 5

I have gotten most of this in place.  The challenges I am having now are as follows:

1.  Closing the files.

2.  How to code it for changes in the data.  I.E. when I startup, I save the dealer_name, Year, Make and Model values to cur* fields.  When the Dealer name changes, I want to save the workbook and then use the new dealer_name to change the directory and open a new workbook to start writing to.  If the Year, Make or Model changes, then I want to close the workbook and start writing to a new workbook.  You can see how I created filelocation 1 & 2.  Also, created a little piece o see of the files exists before I open it and delete the old before I write a new workbook.  Can someone point me in the direction of where & when I should be doing this.  Also, tried several ways to figure out how to close the workbook when I am done with it and I have not found the correct way yet.  Thanx in advance.

=============                    

Option Compare Database

Dim lngMaxInvc As Long
Dim curInvc As Currency
Dim lngdatafnd As Variant

Private Sub cmdClose_Click()

    DoCmd.Close acForm, "frmSplitLtrFile", acSaveYes

End Sub

Private Sub cmdNo_Click()

    Me.Form.Requery

End Sub

Private Sub cmdQuit_Click()

    Me.Undo
    DoCmd.Close

End Sub

Private Sub cmdYes_Click()

On Error GoTo resultsetError

Dim db As Database
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim filelocation1 As String
Dim filelocation2 As String

Set db = CurrentDb()
Set rst1 = db.OpenRecordset("SELECT * from tblVehicle", dbOpenDynaset)
Set rst2 = db.OpenRecordset("SELECT * from tblVehicle2", dbOpenDynaset)

rst1.MoveFirst
rst2.MoveFirst

DoCmd.SetWarnings False

curDlrname = rst2!DlrName
curYear = rst2!Year
curMake = rst2!Make
curModel = rst2!Model

MsgBox curDlrname, vbOKOnly, "RS VALUE"
MsgBox curYear, vbOKOnly, "RS VALUE"
MsgBox curMake, vbOKOnly, "RS VALUE"
MsgBox curModel, vbOKOnly, "RS VALUE"

filelocation1 = "C:\Cloud Data\Development" & "\" & curDlrname & "_" & curYear & "_" & curMake & "_" & curModel & "_1.xls"
filelocation2 = "C:\Cloud Data\Development" & "\" & curDlrname & "_" & curYear & "_" & curMake & "_" & curModel & "_2.xls"

Dim FSO As Object
'Set Object
Set FSO = CreateObject("Scripting.FileSystemObject")

'Check File Exists 
If FSO.FileExists(filelocation1) Then
    FSO.DeleteFile filelocation1, True
    MsgBox "Deleted The File 1 Successfully", vbInformation, "Done!"
End If

If FSO.FileExists(filelocation2) Then
    FSO.DeleteFile filelocation2, True
    MsgBox "Deleted The File 2 Successfully", vbInformation, "Done!"
End If

DoCmd.SetWarnings False

Dim XL As Excel.Application, WB As Excel.Workbook, WKS As Excel.Worksheet
Dim XL2 As Excel.Application, WB2 As Excel.Workbook, WKS2 As Excel.Worksheet

'    Dim db As DAO.Database, rec As DAO.Recordset, f As DAO.Field

Dim f As DAO.Field
Dim f2 As DAO.Field

Dim i As Integer, j As Integer

' Prepare your Excel stuff
Set XL = New Excel.Application
XL.Visible = True
Set WB = XL.Workbooks.Add
WB.Activate
Set WKS = WB.ActiveSheet ' Default: The first sheet in the newly created book

' Read your data here
' A simple table that will show the data from rec
' i and j will be the coordiantes of the active cell in your worksheet

    With rst1
        ActiveWorkbook.SaveAs FileName:=filelocation1
        .MoveFirst
        ' The table headers
        i = 1
        j = 1
        For Each f In .Fields
            WKS.Cells(i, j).Value = f.Name
            j = j + 1
        Next f
        ' The table data
        Do
            i = i + 1
            j = 1
            For Each f In .Fields
                WKS.Cells(i, j).Value = f.Value
                j = j + 1
            Next f
            .MoveNext
        Loop Until rst1.EOF
    End With
'    filelocation1.Close
'    ActiveWorkbook.Close

'''
Set XL2 = New Excel.Application
XL2.Visible = True
Set WB2 = XL2.Workbooks.Add
WB2.Activate
Set WKS2 = WB2.ActiveSheet ' Default: The first sheet in the newly created book

' Read your data here
' A simple table that will show the data from rec
' i and j will be the coordiantes of the active cell in your worksheet

    With rst2
        ActiveWorkbook.SaveAs FileName:=filelocation2
        .MoveFirst
        ' The table headers
        i = 1
        j = 1
        For Each f2 In .Fields
            WKS2.Cells(i, j).Value = f2.Name
            j = j + 1
        Next f2
        ' The table data
        Do
            i = i + 1
            j = 1
            For Each f2 In .Fields
                WKS2.Cells(i, j).Value = f2.Value
                j = j + 1
            Next f2
            .MoveNext
        Loop Until rst2.EOF
    End With
'    ActiveWorkbook.Close

GoTo done

resultsetError:

     MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: cmdYes_Click" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit

Error_Handler_Exit:
    On Error Resume Next
    Exit Sub

done:

  rst1.Close
  rst2.Close
  Set rst1 = Nothing
  Set rst2 = Nothing

MsgBox " Vehicle Table is Split."

End Sub

Private Sub Close_Form_Click()

    Me.Undo
    DoCmd.Close acForm, Me.Name

End Sub

Answer 6

I see that when I do a " .MoveNext", I can check for the values having changed.  If they are not equal to the cur* fields, then I need to save & close the workbook.  Then I have create another filelocation1, open it, get the header lines and then continue with moving through the recordset.  I cannot figure out how to save & close the existing workbook, so I can start another one.  Any direction would be great.  Thanx.

Answer 7

I have gotten through this challenge.  much debugging, but I have been able to get this to work as I wanted.  Thanx for all the direction in helping me get there.

Answer 8

I have gotten through this challenge.  much debugging, but I have been able to get this to work as I wanted.

Hi ballj_351,

Debugging, debugging, debugging. The Debugger is your closest friend.

For that purpose I use a small functionality to invoke a stop dynamically.

Imb.