Solved Access to Excel link (1 Viewer)

[Momma]

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!

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

 

[arnelgp]

i just noticed on your later part of the code,

520 NewxlFile = xlFolder & NewxlFile

when in fact line 260 already has put xlFolder to NwxlFile.

another thing, i think you should Copy the template macro excel to NewXlFile).
then open NewxlFile and do the processing.

 

[Momma]

i just noticed on your later part of the code,

520 NewxlFile = xlFolder & NewxlFile

when in fact line 260 already has put xlFolder to NwxlFile.

another thing, i think you should Copy the template macro excel to NewXlFile).
then open NewxlFile and do the processing.

Thank you for your reply, Arnelgp. I didn't notice I've duplicated that row, so thank you for picking it up.
The Excel Macro creates a pivottable and from the pivottable I create a new worksheet with a different format. I then copy the new worksheet to a new file which is the file I try to open from Access. So NewXLFile is actually the end result from the Macro.
This is the macro:

Sub MakePivotTable()

          'Declare Variables
          Dim PSheet As Worksheet
          Dim DSheet As Worksheet
          Dim WSheet As Worksheet
          Dim PCache As PivotCache
          Dim PTable As PivotTable
          Dim PRange As Range
          Dim lastrow As Long
          Dim LastCol As Long
          Dim PivotRange As Range
          Dim iRange As Range
          Dim iCells As Range
          
          'Insert a New Blank Worksheet
10        On Error Resume Next
20        Worksheets("pivottable").Activate
30        Application.DisplayAlerts = False
40        Worksheets("Weights").Delete
50        Worksheets("PivotTable").Delete
60        Sheets.Add before:=ActiveSheet
70        ActiveSheet.Name = "Weights"
80        Sheets.Add.Name = "PivotTable"
90        Application.DisplayAlerts = True
100       Set PSheet = Worksheets("PivotTable")
110       Set DSheet = Worksheets("Data")
          
          'Import Date from Access and create PivotTable
          'ActiveWorkbook.RefreshAll
          'DoEvents
          'Define Data Range
120       lastrow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
130       LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
140       Set PRange = DSheet.Cells(1, 1).Resize(lastrow, LastCol)

          'Define Pivot Cache
150       Set PCache = ActiveWorkbook.PivotCaches.Create _
              (SourceType:=xlDatabase, SourceData:=PRange). _
              CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
              TableName:="LitterWeightsTable")

          'Insert Blank Pivot Table
160       Set PTable = PCache.CreatePivotTable _
              (TableDestination:=PSheet.Cells(1, 1), TableName:="LitterWeightsTable")

          'Insert Row Fields
170       With ActiveSheet.PivotTables("LitterWeightsTable").PivotFields("Puppy")
180           .Orientation = xlRowField
190           .Position = 1
200       End With

          'Insert Column Fields
210       With ActiveSheet.PivotTables("LitterWeightsTable").PivotFields("TreatmentDate")
220           .Orientation = xlColumnField
230           .Position = 1
240       End With

          'Insert Data Field
250       With ActiveSheet.PivotTables("LitterWeightsTable").PivotFields("Weight")
260           .Orientation = xlDataField
270       End With

          'Format Pivot Table
280       Range("c3:U3").NumberFormat = "ddMMM"
290       With ActiveSheet.PivotTables("LitterWeightsTable")
300           .ColumnGrand = False
310           .RowGrand = False
320       End With
                  
          'Copy PivotTable to new Worksheet
330       Worksheets("PivotTable").Activate
340       Range("B4:U18").Copy
350       Sheets("Weights").Range("A7").PasteSpecial , Paste:=xlPasteValuesAndNumberFormats
          'Application.CutCopyMode = False
360       Worksheets("PivotTable").Activate
370       Range("C3:U3").Copy
380       Sheets("Weights").Range("B6").PasteSpecial , Paste:=xlPasteValuesAndNumberFormats
390       Worksheets("template").Activate
400       Range("A1:A3").Copy
410       Sheets("Weights").Range("A1").PasteSpecial , Paste:=xlPasteValuesAndNumberFormats
420       Range("B5:T5").Copy
430       Sheets("Weights").Range("B5").PasteSpecial , Paste:=xlPasteValuesAndNumberFormats
440       Application.CutCopyMode = False
450       Worksheets("weights").Activate
460       On Error Resume Next
          
          'Format worksheet "Weights"
470       Application.DisplayAlerts = False
480       Range("A5").Value = "Puppies"
490       With Range("A5:A6")
500           .Merge
510           .HorizontalAlignment = xlCenter
520           .VerticalAlignment = xlCenter
530           .Font.Bold = True
540       End With
550       Application.DisplayAlerts = True

560       With Range("B5:T6")
570           .HorizontalAlignment = xlCenter
580           .Font.Bold = True
590       End With

600       With Range("A7:A18")
610           .HorizontalAlignment = xlCenter
620           .VerticalAlignment = xlCenter
630           .Font.Bold = True
640       End With

650       With Range("B7:T18")
660           .HorizontalAlignment = xlCenter
670           .VerticalAlignment = xlCenter
680           .NumberFormat = "0.000"
690       End With

700       With Range("A1:A3")
710           .Font.Bold = True
720           .Font.Size = 14
730           .Font.Name = "Calibri"
740       End With

750       With Range("A5:T18")
760           .Font.Name = "Calibri"
770           .Font.Size = 11
780       End With
          
790       Set iRange = Range("A5:T18")
800       For Each iCells In iRange
810           iCells.BorderAround _
                  LineStyle:=xlContinuous, _
                  Weight:=xlThin
820       Next iCells
          
830       With Range("b5:t6").Borders(xlInsideHorizontal)
840           .LineStyle = XlLineStyle.xlLineStyleNone
850       End With
860       Range("A5:T6").Interior.Color = RGB(218, 238, 243)
870       Range("A7:A18").Interior.Color = RGB(218, 238, 243)

880       Range("A7:A18").EntireRow.RowHeight = 25
          Dim Last_Row As Long
          Dim Last_Col As Long
          Dim Last_Cell As Range
890       On Error Resume Next
900       Last_Row = Range("b7").End(xlDown).Row
910       Last_Col = Range("b7").End(xlToRight).Column

          'Cells(Last_Row, Last_Col).Select
          
920       With ActiveSheet.PageSetup
930           .LeftMargin = Application.InchesToPoints(0.1)
940           .RightMargin = Application.InchesToPoints(0.1)
950           .Orientation = xlLandscape
960           .Zoom = False
970       End With

          'Copy worksheet "Weights" to new xlfile and close Excel
          Dim Name As Range
980       Set Name = Worksheets("Headings").Range("B2")
          Dim Number As Range
990       Set Number = Worksheets("Headings").Range("C2")
          Dim FolderPath As String, Filename As String, NewxlFile As String
1000      FolderPath = "C:\Litter Weights\"
1010      NewxlFile = Name & " Litter " & Number & " weights.xlsx"
1020      NewxlFile = FolderPath & NewxlFile
1030      If Dir(NewxlFile) <> "" Then
1040          Kill (NewxlFile)
1050      End If
1060      ActiveSheet.Copy
1070      ActiveWorkbook.SaveAs FolderPath & Filename, FileFormat:=xlOpenXMLWorkbook
1080      ActiveWorkbook.Close Savechanges:=False
1090      ActiveWorkbook.Close Savechanges:=False

End Sub

 

[bastanu]

Could you please try the suggestion in this link (turn Calculation to Manual before RefreshAll then back to automatic - see the second to last post):

Excel 2016 - Refresh All not working through Macro - Microsoft: Office - Tek-Tips

I have an Excel file with a tab that is linked to an Access table. Other tabs in the workbook have named formulas that refer to the data in the data range from

www.tek-tips.com

You might also be interested in having a look at my code that creates a (in Excel) pivot table from an Access query:

FBA Pivot Table Designer - ForestByteApps

ForestByteApps - A place for Microsoft Access code samples and utilities to make your life easier. Free Microsoft Access tools and sample VBA code

forestbyte.com

Cheers,

 

[Momma]

Could you please try the suggestion in this link (turn Calculation to Manual before RefreshAll then back to automatic - see the second to last post):

Excel 2016 - Refresh All not working through Macro - Microsoft: Office - Tek-Tips

I have an Excel file with a tab that is linked to an Access table. Other tabs in the workbook have named formulas that refer to the data in the data range from

www.tek-tips.com

You might also be interested in having a look at my code that creates a (in Excel) pivot table from an Access query:

FBA Pivot Table Designer - ForestByteApps

ForestByteApps - A place for Microsoft Access code samples and utilities to make your life easier. Free Microsoft Access tools and sample VBA code

forestbyte.com

Cheers,

Thank you Bastanu, I will have a look at those.

 

[Momma]

Thank you Bastanu, I will have a look at those.

I had a look at your Pivot Table Designer. The programming is way beyond my knowledge and find it difficult to follow exactly what's happening there, especially with the form. Do you mind explaining it to me?

 

[bastanu]

The form is trying to simulate the interface used to build a pivot table (which used to be included with Access). It allows to select a query as the source and then start selecting the data elements (rows, columns data fields, etc.). It would then create a new Excel and export the query data to one sheet then build the pivot on another or it would refresh an existing Excel file with the new data in case you want to use an existing Excel template with formatting.

If you need answers regarding specific pieces of the code please let me know!

Cheers,

 

[Momma]

The form is trying to simulate the interface used to build a pivot table (which used to be included with Access). It allows to select a query as the source and then start selecting the data elements (rows, columns data fields, etc.). It would then create a new Excel and export the query data to one sheet then build the pivot on another or it would refresh an existing Excel file with the new data in case you want to use an existing Excel template with formatting.

If you need answers regarding specific pieces of the code please let me know!

Cheers,

Thank you Vlad, I will go through the code and let you know. I will close this thread and start a conversation with you, if that's ok??

 

[bastanu]

Sure

Cheers,