none
Export/writing Access 2016 tables to many excel spreadsheets RRS feed

  • 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.
    Saturday, February 24, 2018 4:08 PM

Answers

  • 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.
    • Marked as answer by ballj_351 Friday, March 2, 2018 12:15 AM
    Friday, March 2, 2018 12:15 AM

All replies

  • 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

    Saturday, February 24, 2018 7:54 PM
  • 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!

    Saturday, February 24, 2018 8:25 PM
  • 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

    Saturday, February 24, 2018 11:39 PM
  • 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 MSDNFSF@microsoft.com.

    Wednesday, February 28, 2018 8:38 AM
  • 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

    Thursday, March 1, 2018 5:20 PM
  • 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.
    Thursday, March 1, 2018 7:33 PM
  • 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.
    • Marked as answer by ballj_351 Friday, March 2, 2018 12:15 AM
    Friday, March 2, 2018 12:15 AM
  • 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.

    Friday, March 2, 2018 8:37 AM