Hi guys,
I have a vba to auto export access data to excel. the function 'SendTQ2XLWbSheet' is activated by an access macro.
There are many workbooks to be exported to and each has 2 tabs "Sheet1" and "Sheet1". I save these files with "sheet1" view (so when i open these files, it will be on sheet1 tab). the above code sends data to "Sheet2" tab. I have an error msg "Selection of method error ..." when i ran this code.
Problem is I have another code that automates entry into Sheet1 that is why i need to save the files on "sheet1" tab and this has to be run first.
And as the 'SendTQ2XLWbSheet' function works on Sheet2 tab, what i would have to do is run code1 (this code auto closes the file), reopen the file and switch from "Sheet1" tab to "Sheet2" tab and save the file. I need to do this for all the files before runnning the function...
i have attaached the code below. Can someone pls help me to modify the code so this function when run will export data to the specific "Sheet2" tab even though the file is saved on "Sheet1" tab and returning the view to "Sheet1" (or simply, make the vba run invisible without changing tabs)
I suspect i would have to modify the "activesheet" portion of the code but not quite sure how. And i found online link http://it.toolbox.com/wiki/index.php/Basics_of_Excel_VBA:_Sheet_Navigation
but didnt quite know the relevance
Sorry if the code appears messy
-----------------------------
Public Function SendTQ2XLWbSheet(strTQName As String, strSheetName As String, strFilePath As String) 'Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.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(strTQName)
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Open(strPath)
ApXL.Visible = True
If checkExcelSheet(strSheetName, xlWBk) Then
Set xlWSh = xlWBk.Worksheets(strSheetName)
Else
Set xlWSh = xlWBk.Worksheets.Add
End If
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
With ApXL.Selection.Font
.Name = "Arial"
.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
ApXL.ActiveSheet.Cells.Select
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
xlWSh.Range("A1").Select
rst.Close
Set rst = Nothing
xlWBk.Close True
ApXL.Quit
Set ApXL = Nothing
Exit_SendTQ2XLWbSheet:
Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_SendTQ2XLWbSheet
End Function
Function checkExcelSheet(strWS As String, xlWb As Object) As Boolean
Dim xlWS As Object
Dim blnFound As Boolean
For Each xlWS In xlWb.Worksheets
If xlWS.Name = strWS Then
blnFound = True
Exit For
End If
Next
checkExcelSheet = blnFound
End Function
I have a vba to auto export access data to excel. the function 'SendTQ2XLWbSheet' is activated by an access macro.
There are many workbooks to be exported to and each has 2 tabs "Sheet1" and "Sheet1". I save these files with "sheet1" view (so when i open these files, it will be on sheet1 tab). the above code sends data to "Sheet2" tab. I have an error msg "Selection of method error ..." when i ran this code.
Problem is I have another code that automates entry into Sheet1 that is why i need to save the files on "sheet1" tab and this has to be run first.
And as the 'SendTQ2XLWbSheet' function works on Sheet2 tab, what i would have to do is run code1 (this code auto closes the file), reopen the file and switch from "Sheet1" tab to "Sheet2" tab and save the file. I need to do this for all the files before runnning the function...
i have attaached the code below. Can someone pls help me to modify the code so this function when run will export data to the specific "Sheet2" tab even though the file is saved on "Sheet1" tab and returning the view to "Sheet1" (or simply, make the vba run invisible without changing tabs)
I suspect i would have to modify the "activesheet" portion of the code but not quite sure how. And i found online link http://it.toolbox.com/wiki/index.php/Basics_of_Excel_VBA:_Sheet_Navigation
but didnt quite know the relevance
Sorry if the code appears messy
-----------------------------
Public Function SendTQ2XLWbSheet(strTQName As String, strSheetName As String, strFilePath As String) 'Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.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(strTQName)
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Open(strPath)
ApXL.Visible = True
If checkExcelSheet(strSheetName, xlWBk) Then
Set xlWSh = xlWBk.Worksheets(strSheetName)
Else
Set xlWSh = xlWBk.Worksheets.Add
End If
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
With ApXL.Selection.Font
.Name = "Arial"
.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
ApXL.ActiveSheet.Cells.Select
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
xlWSh.Range("A1").Select
rst.Close
Set rst = Nothing
xlWBk.Close True
ApXL.Quit
Set ApXL = Nothing
Exit_SendTQ2XLWbSheet:
Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_SendTQ2XLWbSheet
End Function
Function checkExcelSheet(strWS As String, xlWb As Object) As Boolean
Dim xlWS As Object
Dim blnFound As Boolean
For Each xlWS In xlWb.Worksheets
If xlWS.Name = strWS Then
blnFound = True
Exit For
End If
Next
checkExcelSheet = blnFound
End Function