За последние несколько дней я был на ТАК и у меня есть какой-то 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;
Iнеобходимо выполнить этот запрос от нажатия кнопки на форме;когда я пытаюсь запустить его, я получаю сообщение об ошибке, что слишком мало параметров передается для дат .. поэтому я изменил этот хранимый запрос на «в строке», который выглядит так:
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, который будет использоваться для веб-приложения «факс бластер».Файл факсимильного бластера не всегда отправляется каждый день, поэтому мне нужно добавлять, а не создавать новый файл (я делаю это и для избыточности, но у нас были проблемы с партнерами, не добавляющими файлы вручную)
Вот мой код целиком:
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, будет принята с благодарностью.