sql - 将访问查询附加到 Excel 工作表
问题描述
在过去的几天里,我一直很忙,并且有一些 vba/SQL 几乎可以满足我的需求。
我已经打开了我的 excel 工作簿。但它不会将我的查询结果复制到工作表中,我不知道为什么。我已经测试了另一个查询,它运行完美..不确定我更新的查询有什么问题..
从访问对象面板运行时正常工作的存储查询:
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;
我需要通过按下表单上的按钮来运行此查询;当我尝试运行它时,我收到一个关于为日期传递的参数太少的错误。所以我从这个存储的查询更改为一个看起来像这样的“行内”:
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 的“fax blaster”应用程序。并非总是每天发送传真冲击波文件,这就是为什么我需要附加而不是创建新文件的原因(我也这样做是为了冗余,但我们遇到了同事不手动附加文件的问题)
这是我的完整代码:
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 文件的任何帮助都非常感谢。
解决方案
因此,上述所有代码都可以正常工作。在 excel 工作簿/工作表中似乎直接出现了某种错误。我重新创建了工作簿,一切都按预期工作。
推荐阅读
- create-react-app - npm start 命令不启动开发服务器
- java - 如何使用 switch case 格式化 Java 中的给定日期?
- jquery - JQuery中如何删除元素
- javascript - 当我单击 html 和 JavaScript 的联系表单按钮时遇到问题,Django 的 API 位于 heroku 中,它给出了以下错误:HTTP ERROR 405
- python - 对象类型“int”在二维数组打印中没有 len()
- c - 打印字符时正在输出随机值
- python - 将 groupby 的结果合并到 pandas 的原始数据框中
- parsing - 在 Prolog 中创建能够解析树的 DCG
- asp.net-core - Persina datepicker 在单击提交按钮后不保留先前选择的日期
- html - 伪元素未在反应中显示