J
Jack
Hi,
I am try to use transfer spreadsheet method to export an output from a
dynamic sql statement to a excel spreadsheet (this one already exists). I
would like to transfer this to a worksheet in this excel spreadsheet The
worksheet name is doc.
I would like to know whether this is possible. When I am transferring this a
new worksheet with the name of the query is getting generated.
I appreciate any help for resolution of this issue. Thanks
CODE:
'For excel export only
On Error GoTo Err_cmdSubmitE_Click
Dim stDocName As String
Dim stLinkCriteria As String
Dim strBizUnit As String
' DoCmd.OpenForm "frmCompositeSearch"
DoCmd.OpenForm "frmCompositeSearch"
Forms!frmCompositeSearch.Visible = False
stDocName = "frmActionRequestFiltered"
'Debug.Print ("Hey You")
If IsNull(Frame71.Value) Then
'Add Message Box
MsgBox ("You must choose a type of business unit")
Exit Sub
End If
If Frame71.Value = 3 Then
' stLinkCriteria = "[BizUnit]=" & "'" & Me![txtBusUnit] & "'"
Else
stLinkCriteria = "[BizUnit]=" & "'" & Me![txtBusUnit] & "'"
End If
If Me.txtOpenClosed <> "" Then
stLinkCriteria = stLinkCriteria _
& " And " & "[Status]=" & "'" & Me![txtOpenClosed] & "'"
End If
If Me.cboplant <> "" Then
stLinkCriteria = stLinkCriteria _
& " And " & "[Plant]=" & "'" & Me.cboplant & "'"
' Me.cboplant.Value = ""
End If
If Me.cboCust <> "" Then
stLinkCriteria = stLinkCriteria _
& " And " & "[Customer Supplier]=" & "'" & Me.cboCust & "'"
'Me.cboCust.Value = ""
End If
If Me.cboSource1 <> "" Then
stLinkCriteria = stLinkCriteria _
& " And " & "[Source]=" & "'" & Me![cboSource1] & "'"
End If
If Me.cboDefectCode <> "" Then
stLinkCriteria = stLinkCriteria _
& " And " & "[Defect Code]=" & "'" & Me![cboDefectCode] & "'"
End If
If Me.cboCategory <> "" Then
stLinkCriteria = stLinkCriteria _
& " And " & "[Category]=" & "'" & Me![cboCategory] & "'"
End If
If Me.txtStartDate <> "" And Me.txtEndDate <> "" Then
stLinkCriteria = stLinkCriteria _
& " And " & "[RequestDate]" & " Between " _
& "#" & Me![txtStartDate] & "#" & " And " _
& "#" & Me![txtEndDate] + 1 & "#"
End If
Debug.Print ("Right Here")
If Frame71.Value = 3 Then
stLinkCriteria = Mid(stLinkCriteria, 6)
End If
Debug.Print sql
'CODE ADDED FOR TRANSFER OF FILTERED DATA TO EXCEL
Dim strwhere As String
Dim strFile As String
Const strcStuc = "select * from qryRptIndustrialCar1E " & vbCrLf
'Const strcTail = "Order by somefield"
Const strcExportQuery = "Query11" 'Name of the query for exports
strwhere = "WHERE " & stLinkCriteria & vbCrLf
CurrentDb.QueryDefs(strcExportQuery).sql = strcStuc & strwhere
strFile = "c:\CarLogExport.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, _
strcExportQuery, strFile
Dim xlApp As Excel.Application
Dim xlWrkbk As Excel.Workbook
Dim xlWrkSt As Excel.Worksheet
Dim xlSourceRange As Excel.Range
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWrkbk = xlApp.Workbooks.Open(strFile)
Set xlSourceRange = xlWrkbk.Worksheets(1).Range("a15").CurrentRegion
Exit_cmdSubmitE_Click:
Exit Sub
Err_cmdSubmitE_Click:
MsgBox Err.Description
Resume Exit_cmdSubmitE_Click
I am try to use transfer spreadsheet method to export an output from a
dynamic sql statement to a excel spreadsheet (this one already exists). I
would like to transfer this to a worksheet in this excel spreadsheet The
worksheet name is doc.
I would like to know whether this is possible. When I am transferring this a
new worksheet with the name of the query is getting generated.
I appreciate any help for resolution of this issue. Thanks
CODE:
'For excel export only
On Error GoTo Err_cmdSubmitE_Click
Dim stDocName As String
Dim stLinkCriteria As String
Dim strBizUnit As String
' DoCmd.OpenForm "frmCompositeSearch"
DoCmd.OpenForm "frmCompositeSearch"
Forms!frmCompositeSearch.Visible = False
stDocName = "frmActionRequestFiltered"
'Debug.Print ("Hey You")
If IsNull(Frame71.Value) Then
'Add Message Box
MsgBox ("You must choose a type of business unit")
Exit Sub
End If
If Frame71.Value = 3 Then
' stLinkCriteria = "[BizUnit]=" & "'" & Me![txtBusUnit] & "'"
Else
stLinkCriteria = "[BizUnit]=" & "'" & Me![txtBusUnit] & "'"
End If
If Me.txtOpenClosed <> "" Then
stLinkCriteria = stLinkCriteria _
& " And " & "[Status]=" & "'" & Me![txtOpenClosed] & "'"
End If
If Me.cboplant <> "" Then
stLinkCriteria = stLinkCriteria _
& " And " & "[Plant]=" & "'" & Me.cboplant & "'"
' Me.cboplant.Value = ""
End If
If Me.cboCust <> "" Then
stLinkCriteria = stLinkCriteria _
& " And " & "[Customer Supplier]=" & "'" & Me.cboCust & "'"
'Me.cboCust.Value = ""
End If
If Me.cboSource1 <> "" Then
stLinkCriteria = stLinkCriteria _
& " And " & "[Source]=" & "'" & Me![cboSource1] & "'"
End If
If Me.cboDefectCode <> "" Then
stLinkCriteria = stLinkCriteria _
& " And " & "[Defect Code]=" & "'" & Me![cboDefectCode] & "'"
End If
If Me.cboCategory <> "" Then
stLinkCriteria = stLinkCriteria _
& " And " & "[Category]=" & "'" & Me![cboCategory] & "'"
End If
If Me.txtStartDate <> "" And Me.txtEndDate <> "" Then
stLinkCriteria = stLinkCriteria _
& " And " & "[RequestDate]" & " Between " _
& "#" & Me![txtStartDate] & "#" & " And " _
& "#" & Me![txtEndDate] + 1 & "#"
End If
Debug.Print ("Right Here")
If Frame71.Value = 3 Then
stLinkCriteria = Mid(stLinkCriteria, 6)
End If
Debug.Print sql
'CODE ADDED FOR TRANSFER OF FILTERED DATA TO EXCEL
Dim strwhere As String
Dim strFile As String
Const strcStuc = "select * from qryRptIndustrialCar1E " & vbCrLf
'Const strcTail = "Order by somefield"
Const strcExportQuery = "Query11" 'Name of the query for exports
strwhere = "WHERE " & stLinkCriteria & vbCrLf
CurrentDb.QueryDefs(strcExportQuery).sql = strcStuc & strwhere
strFile = "c:\CarLogExport.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, _
strcExportQuery, strFile
Dim xlApp As Excel.Application
Dim xlWrkbk As Excel.Workbook
Dim xlWrkSt As Excel.Worksheet
Dim xlSourceRange As Excel.Range
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWrkbk = xlApp.Workbooks.Open(strFile)
Set xlSourceRange = xlWrkbk.Worksheets(1).Range("a15").CurrentRegion
Exit_cmdSubmitE_Click:
Exit Sub
Err_cmdSubmitE_Click:
MsgBox Err.Description
Resume Exit_cmdSubmitE_Click