0
votes

I have been all over SO the last few days and have some vba/SQL that ALMOST does what I want/need.

I have gotten my excel workbook to open.. but it won't copy my query results to the sheet, and I don't know why. I have tested another query and it works perfect.. not sure what is wrong with my updated query..

Stored query that works correctly when run from Access Object Panel:

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 need to run this query from a button press on a form; when I try to run it I get an error about too few parameters being passed for the dates.. so I changed from this stored query to an 'in line' that looks like this:

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)

I get no errors when running this query off the button, but nothing appears either.. I then pass this information on to my excel portion like this:

 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

This opens my workbook and everything correctly, but its not appending my query.. so I assume something is wrong with my query, but not sure how to track down the exact error.

My objective is to pull a set of fax information from an SQL linked table and export it to an excel sheet that will be used for a web based "fax blaster" application. The fax blaster file isn't always sent every day which is why I need to append and not create a new file (I do this as well for redundancy, but we have had issues with associates not manually appending files)

Here is my code in it's entirety:

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

Any help figuring out why my query won't append to the excel file is greatly appreciated.

1
You appear to open a workbook, dump your recordset into it, and then close it without saving. Maybe toss a .Save in there before your End With and see if that clears it up. - JNevill
adding the .save at the end only has the added benefit of preventing an associate closing without saving.. I am still stuck with ~1437 rows.. and each time I try to run the append.. no new rows are added. Here is where I have added it: With objXL.Workbooks.Item("AutoSavedIPETfaxes.xlsx") lngLastDataRow = .Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row .Worksheets("Sheet1").Range("A" & CStr(lngLastDataRow + 1)).CopyFromRecordset objRS .Save End With - Checht

1 Answers

0
votes

So, all of the above code works correctly.. There seemed to have been some kind of error in the excel workbook/sheet directly. I recreated the workbook and everything is working as intended.