Question

最近几天，我一直忙得不可开交，并拥有一些vba / SQL，ALMOST可以满足我的需求。

我已经打开了我的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文件的帮助。

Answer 1

因此，以上所有代码均能正常工作。.似乎直接在excel工作簿/工作表中存在某种错误。我重新创建了工作簿，一切都按预期进行。

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

1 个答案: