Hi there
I have this procedure which selects date and write it to two tables. Lower down I do a xlBook.RefreshAll. The data from these two tables should then be imported into the Excel file. This is followed by a DoEvent and I then run the Excel macro from this procedure.
All my code compiled and run perfect with no errors. The problem I have is that it does not run the RefreshAll. Should the DoEvent not create a pause in order for Excel to catch up? If I run this procedure with a Toggle Breakpoint on row 70 and step into each line, it works.
I have tested the Excel side by including the RefreshAll in my Excel Macro. It does not do the RefreshAll if I run the Macro without a Toggle Breakpoint. Adding a Toggle Breakpoint, it works.
I also have a problem getting Excel to open the new file that was created. - Rows 490-540.
Instead of opening the file it opens a blank file (see attachment)??
I'll appreciate any suggestions as to why this is happening.
Thank you!
I have this procedure which selects date and write it to two tables. Lower down I do a xlBook.RefreshAll. The data from these two tables should then be imported into the Excel file. This is followed by a DoEvent and I then run the Excel macro from this procedure.
All my code compiled and run perfect with no errors. The problem I have is that it does not run the RefreshAll. Should the DoEvent not create a pause in order for Excel to catch up? If I run this procedure with a Toggle Breakpoint on row 70 and step into each line, it works.
I have tested the Excel side by including the RefreshAll in my Excel Macro. It does not do the RefreshAll if I run the Macro without a Toggle Breakpoint. Adding a Toggle Breakpoint, it works.
I also have a problem getting Excel to open the new file that was created. - Rows 490-540.
Instead of opening the file it opens a blank file (see attachment)??
I'll appreciate any suggestions as to why this is happening.
Thank you!
Code:
Private Sub LitterReports_Click()
Dim xlFile As String
Dim xlFolder As String
Dim NewxlFile As String
Dim xlapp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim MacroName As String
Dim MacroFilename As String
Dim cn As Object
Dim qry As Object
Dim sql As String
Dim CheckRecords As Long
Dim MotherID As Long
10 MotherID = Me.DogID
Dim Mother As String
20 Mother = Me.CallName
Dim Litternumber As Long
30 Litternumber = InputBox("Enter Litter number")
40 If Litternumber = 0 Then
50 Exit Sub
60 End If
Dim ReproID As Long
70 ReproID = DLookup("reproductionid", "[tblreproduction]", "[motherid]=" & [MotherID] & " and [mlittercount] = " & Litternumber & "")
Dim WhelpingDate As Date
80 WhelpingDate = DLookup("whelpingdate", "[tblreproduction]", "[motherid]=" & [MotherID] & " and [mlittercount] = " & Litternumber & "")
90 xlFolder = "C:\Litter Weights\"
100 xlFile = "Weight Chart.xlsm"
110 DoCmd.OpenQuery "Empty tblHeadings"
120 DoCmd.OpenQuery "Empty tblWeights"
130 DoCmd.RunSQL "INSERT INTO tblHeadings (motherID, callname, Litternumber, whelpingdate) " & _
"VALUES (" & MotherID & ", """ & CallName & """," & Litternumber & ",#" & WhelpingDate & "#)"
140 sql = "SELECT Puppynumber, Weight, TreatmentDate FROM " & _
"(SELECT tblDogs.PuppyNumber, tblMedicalTreatments.TreatmentDate, tblMedicalTreatments.Weight, tblMedicalTreatments.TreatmentTypeID " & _
"FROM tblMedicalTreatments INNER JOIN tblDogs ON tblMedicalTreatments.DogID = tblDogs.DogID " & _
"WHERE (((tblMedicalTreatments.TreatmentTypeID) = 7)) AND tblDogs.ReproductionID = " & ReproID & " " & _
"ORDER BY tblDogs.PuppyNumber)"
150 DoCmd.RunSQL "INSERT INTO tblWeights (Puppy, Weight, TreatmentDate) " & sql
160 CheckRecords = DCount("*", "tblWeights")
170 If CheckRecords = 0 Then
180 MsgBox ("There are no Weight Records for this litter!")
190 Exit Sub
200 End If
210 xlFile = xlFolder & xlFile
220 If Dir(xlFile) = "" Then
230 MsgBox ("The file " & xlFile & " does not exist! ")
240 Exit Sub
250 End If
260 NewxlFile = xlFolder & Mother & " Litter " & Litternumber & " Weights" & ".xlsx"
270 MacroName = "makePivottable"
280 MacroFilename = "C:\Litter Weights\Weight Chart.xlsm"
290 Set xlapp = New Excel.Application
300 Set xlBook = xlapp.Workbooks.Open(MacroFilename)
310 Set xlSheet = xlBook.Worksheets(1)
320 xlapp.Visible = False
330 xlSheet.Activate
340 xlBook.RefreshAll
350 DoEvents
360 On Error Resume Next
370 With xlapp
380 .Run MacroName
390 End With
400 DoEvents
410 For Each cn In xlBook.Connections
420 cn.Delete
430 Next cn
440 For Each qry In xlBook.Queries
450 qry.Delete
460 Next qry
470 xlBook.Close
480 xlapp.Visible = True
Dim answer As String
490 answer = MsgBox("The Litter Weight Report for " & Mother & " Litter " & Litternumber & ", has been created!" & vbNewLine & "Do you want to open the file?", vbYesNo)
500 If answer = vbYes Then
510 xlapp.Visible = True
520 NewxlFile = xlFolder & NewxlFile
530 Set xlBook = xlapp.Workbooks.Open(NewxlFile)
540 End If
550 Set xlapp = Nothing
End Sub