将访问查询附加到Excel工作表

Question

在过去的几天里我一直都是这样，并且有一些几乎完成我想要/需要的vba / SQL。

我已经打开了我的Excel工作簿..但它不会将我的查询结果复制到工作表中，我不知道为什么。我测试了另一个查询，它工作得很完美..不确定我的更新查询有什么问题..

从Access对象面板运行时存储的查询正常工作：

qryPullSpecificFaxes

SELECT ipet_Fax_Stuff.ID, ipet_Fax_Stuff.[Member Name], ipet_Fax_Stuff.DOB, 
ipet_Fax_Stuff.[Shipping Address], ipet_Fax_Stuff.[Humana ID], 
ipet_Fax_Stuff.[Target Drug], ipet_Fax_Stuff.[Target NDC], ipet_Fax_Stuff. 
[Alternate Drug 1], ipet_Fax_Stuff.[Alternate Drug 2], ipet_Fax_Stuff. 
[Alternate Drug 3], ipet_Fax_Stuff.[Prescriber Name], ipet_Fax_Stuff. 
[Prescriber Address], ipet_Fax_Stuff.[Prescriber DEA], ipet_Fax_Stuff. 
[Prescriber NPI], ipet_Fax_Stuff.[Prescriber Phone], ipet_Fax_Stuff. 
[Prescriber Fax], ipet_Fax_Stuff.[Pharmacy Name and Store], ipet_Fax_Stuff. 
[Pharmacy Address], ipet_Fax_Stuff.[Associate ID], ipet_Fax_Stuff.DocKey, 
ipet_Fax_Stuff.Timestamp, ipet_Fax_Stuff.CS_INDICATOR
FROM ipet_Fax_Stuff
WHERE (((ipet_Fax_Stuff.Timestamp) Between [Forms]![TrackedInfoForm]! 
[txtFirstDate] And [Forms]![TrackedInfoForm]![txtSecondDate]))
ORDER BY ipet_Fax_Stuff.Timestamp;

我需要通过按下表单上的按钮来运行此查询;当我尝试运行它时，我得到一个错误，关于日期传递的参数太少..所以我从这个存储的查询更改为“in in”，如下所示：

Dim strstartdate As Date
Dim strenddate As Date
strstartdate = Me.txtFirstDate.Value
strenddate = Me.txtSecondDate.Value
'query to use
strSQL = "SELECT * FROM ipet_Fax_stuff WHERE ipet_Fax_Stuff.Timestamp 
BETWEEN #" & strstartdate & "# AND #" & strenddate & "#"
Set objRS = objDB.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)

关闭按钮运行此查询时没有出现任何错误，但是没有任何内容出现..然后我将此信息传递给我的excel部分，如下所示：

 Dim lngLastDataRow As String

With objXL.Workbooks.Item("AutoSavedIPETfaxes.xlsx")
lngLastDataRow = 
.Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
.Worksheets("Sheet1").Range("A" & CStr(lngLastDataRow + 
1)).CopyFromRecordset objRS
End With

objXL.Visible = True
Set objRS = Nothing
Set objXL = Nothing

这会正确打开我的工作簿和所有内容，但它不会附加我的查询..所以我假设我的查询有问题，但不知道如何追踪确切的错误。

我的目标是从SQL链接表中提取一组传真信息，并将其导出到Excel工作表，该工作表将用于基于Web的“传真冲击波”应用程序。传真发送器文件并不总是每天发送，这就是我需要附加而不是创建新文件的原因（我这样做也是为了冗余，但我们遇到的问题是员工没有手动附加文件）

以下是我的代码：

Private Sub btnSpecificFaxes_Click()
'On Error GoTo specificfax_Err

If Me.txtFirstDate.Value = "" And Me.txtSecondDate.Value = "" Then
MsgBox ("Please enter a 'First' and 'Second' search date before pulling 
faxes")
Exit Sub
End If

If Me.txtFirstDate.Value = "" Then
MsgBox ("Please enter a 'First' date before pulling faxes")
Exit Sub
End If

If Me.txtSecondDate.Value = "" Then
MsgBox ("Please enter a 'Second' date before pulling faxes")
Exit Sub
End If



'output file info
Dim strpath As String
strpath = ("Q:\D963\F85307\SHARED\MYB Manual Faxing\Fax Blast Files\Faxes 
Sent\2019 Faxes\AutoSavedIPETfaxes.xlsx")

'create and open the excel workbook
Dim objXL As Object
Set objXL = CreateObject("excel.application")
objXL.Visible = False
objXL.Workbooks.Open (strpath)

'open the database/query
Dim objDB As DAO.Database
Dim objRS As DAO.Recordset
Dim objField As DAO.Field
Set objDB = CurrentDb

Dim strSQL As String
'query parameters
Dim strstartdate As Date
Dim strenddate As Date
strstartdate = Me.txtFirstDate.Value
strenddate = Me.txtSecondDate.Value
'query to use
strSQL = "SELECT * FROM ipet_Fax_stuff WHERE ipet_Fax_Stuff.Timestamp 
BETWEEN #" & strstartdate & "# AND #" & strenddate & "#"
Set objRS = objDB.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)

Dim lngLastDataRow As String

With objXL.Workbooks.Item("AutoSavedIPETfaxes.xlsx")
lngLastDataRow = 
.Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
.Worksheets("Sheet1").Range("A" & CStr(lngLastDataRow + 
1)).CopyFromRecordset objRS
End With

objXL.Visible = True
Set objRS = Nothing
Set objXL = Nothing

    ' auto saves and appends faxes to file "NewFaxes + today's date.xls"

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, 
"qryPullSpecificFaxes", _
    "Q:\D963\F85307\SHARED\MYB Manual Faxing\Fax Blast Files\Faxes Sent\2019 
Faxes\NewFaxesTEST.xlsx"
'        "Q:\D963\F85307\SHARED\MYB Manual Faxing\Fax Blast Files\Faxes 
Sent\2019 Faxes\NewFaxes " & Format(Date, "mm.dd.yy") & ".xlsx"

' alert user the file exported successfully

    MsgBox "File exported successfully", vbInformation + vbOKOnly, "Export 
Success"

specificfax_Exit:
Exit Sub

specificfax_Err:
MsgBox Error$
Resume specificfax_Exit
End Sub

任何帮助搞清楚为什么我的查询不会附加到excel文件非常感谢。

Answer 1

所以，以上所有代码都能正常工作。直接在Excel工作簿/工作表中出现了某种错误。我重新创建了工作簿，一切都按预期工作。