Assistance with BobLarson Code-Transfer object,format (1 Viewer)

[HeelNGville]

Many thanks to Bob Larson for the code found below!! This helped me tremendously and I am hoping that someone could assist in adding some additional pieces. I would like to add a 'save', close and exit spreadsheet function to this code, however, I have been unable to do so.

Much thanks for any assistance!!!

Public Function TferTbl()
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to


' strFilePath is the name and path of the file you want to send this data into.


    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As Field

    Dim strPath As String

    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107

    On Error GoTo err_handler




    strPath = strFilePath

    Set rst = CurrentDb.OpenRecordset("tblDetail")

    Set ApXL = CreateObject("Excel.Application")

    Set xlWBk = ApXL.Workbooks.Open("H:\My Documents\Test.xls")
    ApXL.Visible = True

    Set xlWSh = xlWBk.Worksheets("Details")

    xlWSh.Range("A1").Select

    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next

    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Verdana"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
    ApXL.Selection.Font.Bold = True
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select

    rst.Close
    Set rst = Nothing

    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function

End Function

 

[boblarson]

Modifications below in red:

Public Function TferTbl()
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
 
 
' strFilePath is the name and path of the file you want to send this data into.
 
 
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As Field
 
    Dim strPath As String
 
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
 
    On Error GoTo err_handler
 
 
 
 
    strPath = strFilePath
 
    Set rst = CurrentDb.OpenRecordset("tblDetail")
 
    Set ApXL = CreateObject("Excel.Application")
 
    Set xlWBk = ApXL.Workbooks.Open("H:\My Documents\Test.xls")
    ApXL.Visible = True
 
    Set xlWSh = xlWBk.Worksheets("Details")
 
    xlWSh.Range("A1").Select
 
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
 
    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Verdana"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
    ApXL.Selection.Font.Bold = True
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
 
[B][COLOR=red]xlWbk.Save[/COLOR][/B]
[B][COLOR=red]xlWbk.Close[/COLOR][/B]
[B][COLOR=red][/COLOR][/B] 
[B][COLOR=red]ApXL.Quit[/COLOR][/B]
[B][COLOR=red][/COLOR][/B] 
[B][COLOR=red]Set ApXL = Nothing[/COLOR][/B] 
 
    rst.Close
    Set rst = Nothing
 
    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function
 
End Function

 

[HeelNGville]

Thank you very much!

 

[HeelNGville]

Hi Bob, thanks again for the code. On a related note, is it possible to modify this code to perform a 'save as' based on two field names from the table referenced in the above code (tblDetail)? The tblDetail has two pertinent fields:

1. Vendor
2. OrderID

Basically, once the code is called, the data from tblDetail is transferred to the workbook 'Test.xls' & worksheet Details. Then the file is saved using the name (always limited to 1) in the Vendor and OrderID fields. So, let's say tblDetail has the following records:

Vendor OrderID
ABCD R123457

The code would run and save the workbook as ABCD-R123457.xls in the same directory.

Thank you in advance!!!

 

[DCrake]

Change this line from

 Set xlWBk = ApXL.Workbooks.Open("H:\My Documents\Test.xls")

to

 Set xlWBk = ApXL.Workbooks.Open("H:\My Documents\" & strVendor & "-" & strOrder & ".xls")

Where strVendor and strOrder are string variables of the vendor code and the order number.

 

[HeelNGville]

Thanks DCrake, but unfortunately this did not work for me. The following error was given, "Unable to get the Open property workbook class".

I failed to mention that the "Test.xls" workbook is a templated file that contains headings and other worksheet data that must remain intact.

Set xlWBk = ApXL.Workbooks.Open("H:\My Documents\" & strVendor & "-" & strOrderID & ".xls")

In the code above, how is the data transferred to the "Test.xls" workbook and then saved as the Vendor-OrderId file name?

Thanks again?

 

[DCrake]

If you have a template file then use FileCopy first to copy the test.xls to the vendor-order.xls

this leaves the template file intact for the next time.

Dim nFile As String

nFile = "H:\Documents\" & StrVendor & "-" & StrOrder & ".xls"

FileCopy "H:\Documents\test.xls", nfile

Set xlWBk = ApXL.Workbooks.Open(nFile)

 

[HeelNGville]

Ok, I currently call a .bat file that copies the Test-tmp.xls (templated file with cover and formulas) and paste that file as Test.xls in the directory mentioned above. The code that Bob provided was perfect until I was asked to store the file by a specific name. What that mentioned, how can I modify the existing code from Bob, to do the following:

In lieu of saving the file as "Test.xls", save the file using a concatenation of "Vendor" & "OrderID" from tblDetails. So, if tblDetails contains:

Vendor-------------OrderID
ABCD---------------R123456

The code would transfer the records from tblDetails to Test.xls (currently doing), then save the file as ABCD-R123456.xls. So, the existing code works, just need to add the piece to 'save as' and use the two field names as part of the filename. My apologies for the recap, but thought I would attempt to be more specific. Thank you again!

 

[HeelNGville]

Any feedback assistance here? Many, many thanks!!

 

[HeelNGville]

Really looking for suggestions on how to resolve this. Anyone?

 

[boblarson]

All you need to do is change to using the SAVE AS and then concatenate the field values in.

xlwb.SaveAs  "FileNameAndPathHere"

You don't say how those values are available to you. Are they in the form from which you are sending this? If so you can use something like this:

Dim strPathAndFile As String
 
strPathAndFile = "C:\MyFolderName\"
strPathAndFile = strPathAndFile & Me!Vendor
strPathAndFile = strPathAndFile & "-" & Me!OrderID & ".xls"
 
xlWb.SaveAs strPathAndFile

 

[HeelNGville]

Thanks Bob.

You don't say how those values are available to you. Are they in the form from which you are sending this?

The 2 field values (Vendor & OrderID) needed are stored in a table named tblDetails.

I will make an attempt to update the current code with your suggestion and let you know how it turns out. Thank you for your help!

 

[HeelNGville]

Ok Bob, I am lost and obvious in over my head. Where exactly in your code provided below, do I insert the modifications that you provided in your last post? Again, this code works perfectly to transfer the table detail to the proper Excel file. Once exported, I would now like to rename the file based on a concatenation of the fields [Vendor] and "-" and [OrderID] that are currently associated with the table tblDetail. The tblDetail is created from a command on a form. Once the table is created, the next step is to call the code below. Again, all is working well, with the exception that I am lost and have no idea where to insert your latest code to actually change the filename. If you could asisst, I would appreciate..and then I can go buy a VB book. Thank you again.

Public Function TferTbl()
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
 
 
' strFilePath is the name and path of the file you want to send this data into.
 
 
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As Field
 
    Dim strPath As String
 
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
 
    On Error GoTo err_handler
 
 
 
 
    strPath = strFilePath
 
    Set rst = CurrentDb.OpenRecordset("tblDetail")
 
    Set ApXL = CreateObject("Excel.Application")
 
    Set xlWBk = ApXL.Workbooks.Open("H:\My Documents\Test.xls")
    ApXL.Visible = True
 
    Set xlWSh = xlWBk.Worksheets("Details")
 
    xlWSh.Range("A1").Select
 
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
 
    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Verdana"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
    ApXL.Selection.Font.Bold = True
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
 
xlWbk.Save
xlWbk.Close
 
ApXL.Quit
 
Set ApXL = Nothing 
 
    rst.Close
    Set rst = Nothing
 
    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function
 
End Function

 

[boblarson]

When you say they are "associated with the table" that means nothing really. Is there only one record in that table? How would we know which record is for this particular set of data? If you have those fields in your query that you are sending to Excel then we can get the value easily enough (as long as there are not many different values in that query for what you are asking).

So I can't tell you how to get that information until you tell me how it relates to the data you are sending to Excel.

 

[HeelNGville]

Ok, let me attempt to be more specific. Within my DB, the table tblDetail is created from a command that is called on a form. This table contains the following field names:

Vendor------OrderID-----Name-----Buyer-----Qty-----COGS

and the data could change from one record (only one unique vendor though) to 1000). So, the table data could look like:

Vendor------OrderID-----Name----------Buyer-----Qty-----Location--COGS
ABCD-------R12345------ABC Co.-------Joe Blow---25------A12345---1000
ABCD-------R12345------ABC Co.-------Joe Blow---50------B45697----500
ABCD-------R12345------ABC Co.-------Jan Doe----75------C98756---25
ABCD-------R12345------ABC Co.-------Joe Blow----100-----B11111---100


Based on the data above, the code should transfer this table data to the Excel file Test.xls (which it current does perfectly btw), then save the file using the Vendor and OrderID as the filename. So the filename for this batch of data above would be: H:\My Documents\ABCD-R12345.xls

This table (tblDetail) will only contain one unique 'Vendor' & one unique 'OrderID'. There will never be an instance in which there will be multiple "Vendor' or 'Order Id', as such (will not occur):

Vendor------OrderID-----Name----------Buyer-----Qty-----Location--COGS
ABCD-------R12345------ABC Co.-------Joe Blow---25------A12345---1000
DEFG-------R19999-------DEF Co.-------Joe Blow---50-----B12222----500

Hopefully this provides more useful insight. Thank you again for the assistance!

 

[DCrake]

Therefore at some point you populated the TblDetail table with a filter of some sort. Anyway in order to know how to dervice the name of the xls file you need to extract the vendor and the orderno from the first record in the table.



Therefore

Dim nfile as String

nFile = "H:\MyDocuments\" & Rst(0) & "-" & Rst(1) & ".xls"

Where Rst(0) and Rst(1) = the first two fields in the first record in the table

This code would appear immediately after the Rst has been set

then

xlWb.SaveAs nFile

 

[HeelNGville]

Thank you DCrake, but perhaps I am overlooking something (which is highly probable), but if I set the code immediately after the rst has been set, I will be bypassing the transfer option to my file 'Test.xls'. If I was simply creating a new file with the 'Vendor' & 'OrderID', that would be great, however I have to transfer the data first to the Test.xls file, then perform the 'save as' 'Vendor' & '-' & 'OrderId'.

Can that be done here with your suggestion?

 

[boblarson]

He means to put it down where the SAVE AS is before you close the recordset. The declaration (DIM ...etc.) would go at the top of the function with the other declarations.

 

[HeelNGville]

Obviously I have inserted the code incorrectly. The data is transferred, however the code freezes after the data is passed to MS Excel and the file remains opened. Yes, I know, this is probaby elementary, but I have no clue...which I why I have lurked on this DB all day. Any help is appreciated before I go jump out of the window. Thank you!

Public Function TferTbls()
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
 
 
' strFilePath is the name and path of the file you want to send this data into.
 
 
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim nfile As String
    
 
    Dim strPath As String
 
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
 
    On Error GoTo err_handler
 
 
 
 
    strPath = strFilePath
 
    Set rst = CurrentDb.OpenRecordset("tblReqDetails")
 
    Set ApXL = CreateObject("Excel.Application")
 
    Set xlWBk = ApXL.Workbooks.Open("H:\My Documents\Test.xls")
    ApXL.Visible = True
 
    Set xlWSh = xlWBk.Worksheets("Details")
 
    xlWSh.Range("A1").Select
 
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
 
    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Verdana"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
    ApXL.Selection.Font.Bold = True
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
 xlWBk.SaveAs nfile = "H:\MyDocuments\" & rst(0) & "-" & rst(1) & ".xls"
xlWBk.Close
 
ApXL.Quit
 
Set ApXL = Nothing
 
    rst.Close
    Set rst = Nothing
 
    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function
 
End Function

 

[boblarson]

Change this:

    xlWSh.Range("A1").Select
 xlWBk.SaveAs nfile = "H:\MyDocuments\" & rst(0) & "-" & rst(1) & ".xls"
xlWBk.Close

to this:

xlWSh.Range("A1").Select
[COLOR=red]nfile = "H:\MyDocuments\" & rst(0) & "-" & rst(1) & ".xls"
[/COLOR]
xlWBk.SaveAs [B][COLOR=red]nfile[/COLOR][/B]
xlWBk.Close