UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Converting To Late Binding, Access 2016    
 
   
th53
post Jan 22 2020, 09:50 AM
Post#1



Posts: 63
Joined: 23-May 13



Hello everyone, long story short we have a roll our of a new OS that is going slower than anticipated resulting in many users of a shared database using different versions of Access. This has resulted in reference errors anytime an update is made by someone using the newer versions of Access. After researching online it appears that late binding is the best solution for the problem but the more i read the more confused i get. Below is the code I am converting and below that is what i have attempted so far with no success:

CODE
Option Compare Database

'=========================================================
'=========================================================
'---------------------------------------------------------
'
'             Export Excel
'
'---------------------------------------------------------
'=========================================================
'=========================================================

Sub Sqls99999(strFile As String)


On Error GoTo ErrorHandler


    Dim dbs     As DAO.Database
    Dim rst     As DAO.Recordset
    Dim xlAp    As Excel.Application
    Dim xlWb    As Excel.Workbook
    Dim xlws    As Excel.Worksheet
    Dim i       As Long
    Dim j       As Long
    Dim j1      As Long
    Dim k       As Long
    Dim x       As Long
    Dim lstrow As Long
    Dim lstrow2 As Long
    Dim s As Integer
    Dim z As Integer
    Dim aa As Integer
    Dim xx As Integer
    Dim yy As Integer
    Dim v As Long
    Dim vaHd()  As String
    Dim Data
    Dim rngMerge As Range, cell As Range
    

    Dim strName As String
    Dim strSaveAsName As String
    Dim aSQL
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim rst3 As DAO.Recordset
    Dim rst4 As DAO.Recordset
    Dim rst5 As DAO.Recordset
    Dim rst6 As DAO.Recordset
    Dim rst7 As DAO.Recordset
    Dim rst8 As DAO.Recordset
    Dim rst9 As DAO.Recordset
    Dim rst10 As DAO.Recordset

    
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlThin = 2
    Const xlOutsideHorizontal = 12
    
    Set dbs = CurrentDb
    Set xlAp = CreateObject("Excel.Application")
    Set xlWb = xlAp.Workbooks.Open("C:\Users\" & VBA.Environ("username") & "\Desktop\Temp.xltx")
    strSaveAsName = "C:\Users\" & VBA.Environ("username") & "\Desktop\Statement\" & "Sample Inc. " & [Forms]![fee]![Prod_Cbo] & " " & "Statement " & " - " & [Forms]![fee]![EndMth_Bx] & " " & [Forms]![fee]![EndYr_Bx] & ".xlsx"



'=================================================
'-------------------------------------------------
'
'       Details
'
'-------------------------------------------------
'=================================================
    
    
     Set xlws = xlWb.Sheets("Summary")
    
     Set rst1 = dbs.OpenRecordset("Tbl_99999_Sample")
      
        With rst1
            .MoveLast
            j = .Fields.Count
            j1 = j - 1
            k = .RecordCount
            ReDim vaHd(j)
            .MoveFirst
            

            For x = 0 To j1
                
           Next
            
            With xlWb
              
              Data = xlws.Cells(4, 2).CopyFromRecordset(rst1)
          
          
           With xlws
           Set rngdata = xlws.Range("B4").CurrentRegion
                    With rngdata
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                    End With
                    
           xlws.Range("B2") = " Sample Inc Inc., " & [Forms]![fee]![Prod_Cbo] & " " & " Statement  - " & [Forms]![fee]![EndMth_Bx] & " " & [Forms]![fee]![EndYr_Bx]
                        
                        End With

           End With
                   End With
        
    
    Set rst1 = Nothing
    
'=================================================
'-------------------------------------------------
'
'      Dealer Totals
'
'-------------------------------------------------
'=================================================

     Set rst2 = dbs.OpenRecordset("Tbl_99999_SellTot")
      
        With rst2
            .MoveLast
            j = .Fields.Count
            j1 = j - 1
            ReDim vaHd(j)
            .MoveFirst
            lstrow = xlws.Cells(xlws.Rows.Count, "B").End(xlUp).Row + 1
            lstrow2 = xlws.Cells(xlws.Rows.Count, "H").End(xlUp).Row
            lstrow3 = xlws.Cells(xlws.Rows.Count, "G").End(xlUp).Row
            z = lstrow + 2
            aa = lstrow + 1

            For x = 0 To j1
             vaHd(x) = .Fields(x).Name
           Next
            
            With xlWb
            
              xlws.Cells(lstrow + 2, 2).Resize(1, j) = vaHd
              Data = xlws.Cells(lstrow + 3, 2).CopyFromRecordset(rst2)
              xlws.Range("B" & aa & ":H" & aa).MergeCells = True
              xlws.Cells(lstrow + 1, 2).Value = "Selling Totals"
          
           End With
                   End With
          
    With xlws
    
    
         Set rngdata = xlws.Cells(lstrow + 3, 2).CurrentRegion
                    With rngdata
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                    
                    End With
                    
    
    End With
    Set rngdata2 = xlws.Range(xlws.Cells(lstrow + 2, 2), xlws.Cells(lstrow + 2, 8))

                    With rngdata2
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                     .Font.Bold = True
                     .Font.Color = vbWhite
                     .Font.Size = 10
                     .Interior.Color = RGB(22, 54, 92)
                     .WrapText = True
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlBottom
                     .FormatConditions.Delete

    Set rngdata3 = xlws.Range(xlws.Cells(lstrow + 1, 2), xlws.Cells(lstrow + 1, 8))

                    With rngdata3
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                     .Font.Bold = True
                     .Font.Color = vbBlack
                     .Font.Size = 12
                     .Interior.Color = RGB(191, 191, 191)
                     .WrapText = True
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlBottom
                     .FormatConditions.Delete

    Set rngdata4 = xlws.Range(xlws.Cells(lstrow3 + 3, 8), xlws.Cells(lstrow3 + 25, 8))
                    With rngdata4
                       .Cells.NumberFormat = "$#,###.00"
                    
    End With

        End With
            
            End With
                    
    Set rst2 = Nothing
    
'=================================================
'-------------------------------------------------
'
'         Company Totals
'
'-------------------------------------------------
'=================================================
    
    
    Set rst3 = dbs.OpenRecordset("Tbl_99999_MTot")
      
        With rst3
            .MoveLast
            j = .Fields.Count
            j1 = j - 1
            ReDim vaHd(j)
            .MoveFirst
            lstrow = xlws.Cells(xlws.Rows.Count, "B").End(xlUp).Row + 1
            z = lstrow + 2
            aa = lstrow + 1

            For x = 0 To j1
             vaHd(x) = .Fields(x).Name
           Next
            
            With xlWb
            
              xlws.Cells(lstrow + 2, 2).Resize(1, j) = vaHd
              Data = xlws.Cells(lstrow + 3, 2).CopyFromRecordset(rst3)
              xlws.Range("B" & aa & ":G" & aa).MergeCells = True
              xlws.Cells(lstrow + 1, 2).Value = "Company Totals"
          
           End With
                   End With
          
    With xlws
    
    
         Set rngdata = xlws.Cells(lstrow + 3, 2).CurrentRegion
                    With rngdata
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                    End With
                    
    
    End With
    Set rngdata2 = xlws.Range(xlws.Cells(lstrow + 2, 2), xlws.Cells(lstrow + 2, 7))

                    With rngdata2
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                     .Font.Bold = True
                     .Font.Color = vbWhite
                     .Font.Size = 10
                     .Interior.Color = RGB(22, 54, 92)
                     .WrapText = True
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlBottom
                     .FormatConditions.Delete

    Set rngdata3 = xlws.Range(xlws.Cells(lstrow + 1, 2), xlws.Cells(lstrow + 1, 7))

                    With rngdata3
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                     .Font.Bold = True
                     .Font.Color = vbBlack
                     .Font.Size = 12
                     .Interior.Color = RGB(191, 191, 191)
                     .WrapText = True
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlBottom
                     .FormatConditions.Delete

                  Set rngdata4 = xlws.Cells(lstrow + 3, 7)
                    With rngdata4
                       .Cells.NumberFormat = "$#,###.00"
    End With
      
        End With

            End With
                    
  
    Set rst3 = Nothing

    
    
Set xlws = Nothing
    
    
xlAp.Visible = True
  
xlWb.Worksheets("Summary").Select


With xlAp
.DisplayAlerts = False


xlWb.SaveAs strSaveAsName, xlOpenXMLWorkbook

.DisplayAlerts = True

End With

ExitFunction:
    If Not xlws Is Nothing Then
      Set xlws = Nothing
    End If
    
    If Not xlWb Is Nothing Then
      Set xlWb = Nothing
    End If

    If Not xlAp Is Nothing Then
      xlAp.Quit
    End If
      
    Exit Sub

ErrorHandler:

If Err.Number = 3021 Then Resume Next Else

    Select Case Err.Number
      Case 0
      Case Else
          MsgBox Err.Number & ": " & Err.Description
          Resume ExitFunction
    End Select
End Sub




Late Binding Attempt:

CODE
Option Compare Database

'=========================================================
'=========================================================
'---------------------------------------------------------
'
'             Export Excel
'
'---------------------------------------------------------
'=========================================================
'=========================================================

Sub Sqls99999(strFile As String)


On Error GoTo ErrorHandler


    Dim dbs     As DAO.Database
    Dim rst     As DAO.Recordset
    Dim xlAp    As Object
    Dim xlWb    As Object
    Dim xlws    As Object
    Dim i       As Long
    Dim j       As Long
    Dim j1      As Long
    Dim k       As Long
    Dim x       As Long
    Dim lstrow As Long
    Dim lstrow2 As Long
    Dim s As Integer
    Dim z As Integer
    Dim aa As Integer
    Dim xx As Integer
    Dim yy As Integer
    Dim v As Long
    Dim vaHd()  As String
    Dim Data
    Dim rngMerge As Range, cell As Range
    

    Dim strName As String
    Dim strSaveAsName As String
    Dim aSQL
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim rst3 As DAO.Recordset
    Dim rst4 As DAO.Recordset
    Dim rst5 As DAO.Recordset
    Dim rst6 As DAO.Recordset
    Dim rst7 As DAO.Recordset
    Dim rst8 As DAO.Recordset
    Dim rst9 As DAO.Recordset
    Dim rst10 As DAO.Recordset

    
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlThin = 2
    Const xlOutsideHorizontal = 12
    
    Set dbs = CurrentDb
    Set xlAp = CreateObject("Excel.Application")
    Set xlWb = xlAp.Workbooks.Open("C:\Users\" & VBA.Environ("username") & "\Desktop\Temp.xltx")
    strSaveAsName = "C:\Users\" & VBA.Environ("username") & "\Desktop\Statement\" & "Sample Inc. " & [Forms]![fee]![Prod_Cbo] & " " & "Statement " & " - " & [Forms]![fee]![EndMth_Bx] & " " & [Forms]![fee]![EndYr_Bx] & ".xlsx"



'=================================================
'-------------------------------------------------
'
'       Details
'
'-------------------------------------------------
'=================================================
    
    
     Set xlws = xlWb.Sheets("Summary")
    
     Set rst1 = dbs.OpenRecordset("Tbl_99999_Sample")
      
        With rst1
            .MoveLast
            j = .Fields.Count
            j1 = j - 1
            k = .RecordCount
            ReDim vaHd(j)
            .MoveFirst
            

            For x = 0 To j1
                
           Next
            
            With xlWb
              
              Data = xlws.Cells(4, 2).CopyFromRecordset(rst1)
          
          
           With xlws
           Set rngdata = xlws.Range("B4").CurrentRegion
                    With rngdata
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                    End With
                    
           xlws.Range("B2") = " Sample Inc Inc., " & [Forms]![fee]![Prod_Cbo] & " " & " Statement  - " & [Forms]![fee]![EndMth_Bx] & " " & [Forms]![fee]![EndYr_Bx]
                        
                        End With

           End With
                   End With
        
    
    Set rst1 = Nothing
    
'=================================================
'-------------------------------------------------
'
'          Selling Totals
'
'-------------------------------------------------
'=================================================

     Set rst2 = dbs.OpenRecordset("Tbl_99999_SellTot")
      
        With rst2
            .MoveLast
            j = .Fields.Count
            j1 = j - 1
            ReDim vaHd(j)
            .MoveFirst
            lstrow = xlws.Cells(xlws.Rows.Count, "B").End(xlUp).Row + 1
            lstrow2 = xlws.Cells(xlws.Rows.Count, "H").End(xlUp).Row
            lstrow3 = xlws.Cells(xlws.Rows.Count, "G").End(xlUp).Row
            z = lstrow + 2
            aa = lstrow + 1

            For x = 0 To j1
             vaHd(x) = .Fields(x).Name
           Next
            
            With xlWb
            
              xlws.Cells(lstrow + 2, 2).Resize(1, j) = vaHd
              Data = xlws.Cells(lstrow + 3, 2).CopyFromRecordset(rst2)
              xlws.Range("B" & aa & ":H" & aa).MergeCells = True
              xlws.Cells(lstrow + 1, 2).Value = "Selling Totals"
          
           End With
                   End With
          
    With xlws
    
    
         Set rngdata = xlws.Cells(lstrow + 3, 2).CurrentRegion
                    With rngdata
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                    
                    End With
                    
    
    End With
    Set rngdata2 = xlws.Range(xlws.Cells(lstrow + 2, 2), xlws.Cells(lstrow + 2, 8))

                    With rngdata2
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                     .Font.Bold = True
                     .Font.Color = vbWhite
                     .Font.Size = 10
                     .Interior.Color = RGB(22, 54, 92)
                     .WrapText = True
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlBottom
                     .FormatConditions.Delete

    Set rngdata3 = xlws.Range(xlws.Cells(lstrow + 1, 2), xlws.Cells(lstrow + 1, 8))

                    With rngdata3
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                     .Font.Bold = True
                     .Font.Color = vbBlack
                     .Font.Size = 12
                     .Interior.Color = RGB(191, 191, 191)
                     .WrapText = True
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlBottom
                     .FormatConditions.Delete

    Set rngdata4 = xlws.Range(xlws.Cells(lstrow3 + 3, 8), xlws.Cells(lstrow3 + 25, 8))
                    With rngdata4
                       .Cells.NumberFormat = "$#,###.00"
                    
    End With

        End With
            
            End With
                    
    Set rst2 = Nothing
    
'=================================================
'-------------------------------------------------
'
'           Company Totals
'
'-------------------------------------------------
'=================================================
    
    
    Set rst3 = dbs.OpenRecordset("Tbl_99999_MTot")
      
        With rst3
            .MoveLast
            j = .Fields.Count
            j1 = j - 1
            ReDim vaHd(j)
            .MoveFirst
            lstrow = xlws.Cells(xlws.Rows.Count, "B").End(xlUp).Row + 1
            z = lstrow + 2
            aa = lstrow + 1

            For x = 0 To j1
             vaHd(x) = .Fields(x).Name
           Next
            
            With xlWb
            
              xlws.Cells(lstrow + 2, 2).Resize(1, j) = vaHd
              Data = xlws.Cells(lstrow + 3, 2).CopyFromRecordset(rst3)
              xlws.Range("B" & aa & ":G" & aa).MergeCells = True
              xlws.Cells(lstrow + 1, 2).Value = "Company Totals"
          
           End With
                   End With
          
    With xlws
    
    
         Set rngdata = xlws.Cells(lstrow + 3, 2).CurrentRegion
                    With rngdata
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                    End With
                    
    
    End With
    Set rngdata2 = xlws.Range(xlws.Cells(lstrow + 2, 2), xlws.Cells(lstrow + 2, 7))

                    With rngdata2
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                     .Font.Bold = True
                     .Font.Color = vbWhite
                     .Font.Size = 10
                     .Interior.Color = RGB(22, 54, 92)
                     .WrapText = True
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlBottom
                     .FormatConditions.Delete

    Set rngdata3 = xlws.Range(xlws.Cells(lstrow + 1, 2), xlws.Cells(lstrow + 1, 7))

                    With rngdata3
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                     .Font.Bold = True
                     .Font.Color = vbBlack
                     .Font.Size = 12
                     .Interior.Color = RGB(191, 191, 191)
                     .WrapText = True
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlBottom
                     .FormatConditions.Delete

                  Set rngdata4 = xlws.Cells(lstrow + 3, 7)
                    With rngdata4
                       .Cells.NumberFormat = "$#,###.00"
    End With
      
        End With

            End With
                    
  
    Set rst3 = Nothing

    
    
Set xlws = Nothing
    
    
xlAp.Visible = True
  
xlWb.Worksheets("Summary").Select


With xlAp
.DisplayAlerts = False


xlWb.SaveAs strSaveAsName, xlOpenXMLWorkbook

.DisplayAlerts = True

End With

ExitFunction:
    If Not xlws Is Nothing Then
      Set xlws = Nothing
    End If
    
    If Not xlWb Is Nothing Then
      Set xlWb = Nothing
    End If

    If Not xlAp Is Nothing Then
      xlAp.Quit
    End If
      
    Exit Sub

ErrorHandler:

If Err.Number = 3021 Then Resume Next Else

    Select Case Err.Number
      Case 0
      Case Else
          MsgBox Err.Number & ": " & Err.Description
          Resume ExitFunction
    End Select
End Sub


Any help is appreciated and thank you for your time!!





Go to the top of the page
 
DanielPineault
post Jan 22 2020, 09:53 AM
Post#2


UtterAccess VIP
Posts: 7,129
Joined: 30-June 11



See

https://www.devhut.net/2016/11/08/vba-early...d-late-binding/
https://www.devhut.net/2017/02/16/vba-early...binding-part-2/

--------------------
Daniel Pineault (2010-2019 Microsoft MVP, UA VIP, EE Distinguished Expert 2018)
Professional Help: https://www.cardaconsultants.com
Free MS Access Code, Tips, Tricks and Samples: https://www.devhut.net

* Design should never say "Look at me". It should always say "Look at this". -- David Craib
* A user interface is like a joke, if you have to explain it, it's not that good! -- Martin LeBlanc


All code samples, demonstration databases, links,... are provided 'AS IS' and are to be used at your own risk! Take the necessary steps to check, validate ...(you are responsible for your choices and actions)
Go to the top of the page
 
th53
post Jan 27 2020, 04:08 PM
Post#3



Posts: 63
Joined: 23-May 13



Thank you for the reply, I have read both articles and I can get the data to export to excel but unfortunately I cannot get the excel formatting to work nor can i use the lastrow functions to work using late binding. Is there a way i can keep similar formatting code and use the lastrow calculations when using late binding?

Thanks again for the help!
Go to the top of the page
 
DanielPineault
post Jan 27 2020, 04:22 PM
Post#4


UtterAccess VIP
Posts: 7,129
Joined: 30-June 11



Can you provide a sample of both so I can take a look at what you are doing exactly.

--------------------
Daniel Pineault (2010-2019 Microsoft MVP, UA VIP, EE Distinguished Expert 2018)
Professional Help: https://www.cardaconsultants.com
Free MS Access Code, Tips, Tricks and Samples: https://www.devhut.net

* Design should never say "Look at me". It should always say "Look at this". -- David Craib
* A user interface is like a joke, if you have to explain it, it's not that good! -- Martin LeBlanc


All code samples, demonstration databases, links,... are provided 'AS IS' and are to be used at your own risk! Take the necessary steps to check, validate ...(you are responsible for your choices and actions)
Go to the top of the page
 
th53
post Jan 27 2020, 04:50 PM
Post#5



Posts: 63
Joined: 23-May 13



Thanks again for responding - with the excel formatting I am trying to add borders to various sets of data that are exported into excel. Below is a sample of the code i currently use with early binding:

CODE
     Set rst2 = dbs.OpenRecordset("Tbl_Individ_SellTot")
      
        With rst2
            .MoveLast
            j = .Fields.Count
            j1 = j - 1
            ReDim vaHd(j)
            .MoveFirst
            
            lstrow = xlws.Range("B" & ws.Rows.Count).End(-4162).Row
            lstrow2 = xlws.Range("H" & ws.Rows.Count).End(-4162).Row
            lstrow3 = xlws.Range("G" & ws.Rows.Count).End(-4162).Row
           'lstrow = xlws.Cells(xlws.Rows.Count, "B").End(xlUp).Row + 1
           'lstrow2 = xlws.Cells(xlws.Rows.Count, "H").End(xlUp).Row
           'lstrow3 = xlws.Cells(xlws.Rows.Count, "G").End(xlUp).Row
          
            z = lstrow + 2
            aa = lstrow + 1

            For x = 0 To j1
             vaHd(x) = .Fields(x).Name
           Next
            
            With xlWb
            
              xlws.Cells(lstrow + 2, 2).Resize(1, j) = vaHd
              Data = xlws.Cells(lstrow + 3, 2).CopyFromRecordset(rst2)
              xlws.Rows(z).RowHeight = 39
              xlws.Range("B" & aa & ":H" & aa).MergeCells = True
              xlws.Cells(lstrow + 1, 2).Value = "Selling Dealer Totals"
          
           End With
                   End With
          
    With xlws
    
    
         Set rngdata = xlws.Cells(lstrow + 3, 2).CurrentRegion
                    With rngdata
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                    
                    End With
                    
    
    End With
    Set rngdata2 = xlws.Range(xlws.Cells(lstrow + 2, 2), xlws.Cells(lstrow + 2, 8))

                    With rngdata2
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                     .Font.Bold = True
                     .Font.Color = vbWhite
                     .Font.Size = 10
                     .Interior.Color = RGB(22, 54, 92)
                     .WrapText = True
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlBottom
                     .FormatConditions.Delete

    Set rngdata3 = xlws.Range(xlws.Cells(lstrow + 1, 2), xlws.Cells(lstrow + 1, 8))

                    With rngdata3
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                     .Font.Bold = True
                     .Font.Color = vbBlack
                     .Font.Size = 12
                     .Interior.Color = RGB(191, 191, 191)
                     .WrapText = True
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlBottom
                     .FormatConditions.Delete

    Set rngdata4 = xlws.Range(xlws.Cells(lstrow3 + 3, 8), xlws.Cells(lstrow3 + 25, 8))
                    With rngdata4
                       .Cells.NumberFormat = "$#,###.00"



The lastrow function is also listed above and i tried to switch it to xlws.range from xlws.cells based on another post but have not been able to get it to work.

Thank you,
Go to the top of the page
 
cheekybuddha
post Jan 27 2020, 04:57 PM
Post#6


UtterAccess Moderator
Posts: 12,262
Joined: 6-December 03
From: Telegraph Hill


I know you haven't shown your whole code, but does it all compile?

You appear to have a lot of opening With ... blocks without any corresponding End With's

Have you got Option Explicit declared at the top of all your code modules? If not, then this is a place to start.

hth,

d

PS, the problem that you asked about is probably that you haven't declared the xl constants (eg xlEdgeBottom, xlInsideHorizontal etc)

--------------------


Regards,

David Marten
Go to the top of the page
 
DanielPineault
post Jan 27 2020, 05:00 PM
Post#7


UtterAccess VIP
Posts: 7,129
Joined: 30-June 11



For the LastRow issue, I use something more along the lines of

CODE
xlws.Cells(xlws.Rows.count, 1).End(-4162).Row


As for the borders, I do something like
CODE
With oExcelWrSht.Range("B1: F" & (LastRow))
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlThick
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThick
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlThick
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlThick
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
        .Borders(xlInsideHorizontal).Weight = xlThin
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
        .Borders(xlInsideVertical).Weight = xlThin
    End With


As cheekybuddha states, dont forget to declare your constants, for instance:
CODE
    Const xlDiagonalDown = 5
    Const xlDiagonalUp = 6
    Const xlEdgeBottom = 9
    Const xlEdgeLeft = 7
    Const xlEdgeRight = 10
    Const xlEdgeTop = 8
    Const xlInsideHorizontal = 12
    Const xlInsideVertical = 11
    Const xlNone = -4142
    Const xlContinuous = 1
    Const xlThin = 2

--------------------
Daniel Pineault (2010-2019 Microsoft MVP, UA VIP, EE Distinguished Expert 2018)
Professional Help: https://www.cardaconsultants.com
Free MS Access Code, Tips, Tricks and Samples: https://www.devhut.net

* Design should never say "Look at me". It should always say "Look at this". -- David Craib
* A user interface is like a joke, if you have to explain it, it's not that good! -- Martin LeBlanc


All code samples, demonstration databases, links,... are provided 'AS IS' and are to be used at your own risk! Take the necessary steps to check, validate ...(you are responsible for your choices and actions)
Go to the top of the page
 
th53
post Jan 27 2020, 05:04 PM
Post#8



Posts: 63
Joined: 23-May 13



I apologize the whole code is listed below:

CODE
Option Compare Database



'=========================================================
'=========================================================
'---------------------------------------------------------
'
'             Export Excel Fee
'
'---------------------------------------------------------
'=========================================================
'=========================================================

Sub SqlsIndivid(strFile As String)


On Error GoTo ErrorHandler


   ' Dim dbs     As DAO.Database
   ' Dim rst     As DAO.Recordset
   ' Dim xlAp    As Excel.Application
   ' Dim xlWb    As Excel.Workbook
   ' Dim xlws    As Excel.Worksheet
    Dim dbs     As Object
    Dim rst     As Object
    Dim xlAp    As Object
    Dim xlWb    As Object
    Dim xlws    As Object
    Dim i       As Long
    Dim j       As Long
    Dim j1      As Long
    Dim k       As Long
    Dim x       As Long
    Dim lstrow As Long
    Dim lstrow2 As Long
    Dim lstrow3 As Long
    Dim s As Integer
    Dim z As Integer
    Dim aa As Integer
    Dim xx As Integer
    Dim yy As Integer
    Dim v As Long
    Dim vaHd()  As String
    Dim Data
    Dim rngdata As Object
   'Dim rngMerge As Range, cell As Range
    

    Dim strName As String
    Dim strSaveAsName As String
    Dim aSQL
    Dim rst1 As Object
    Dim rst2 As Object
    Dim rst3 As Object
    Dim rst4 As Object
    Dim rst5 As Object
    Dim rst6 As Object
    Dim rst7 As Object
    Dim rst8 As Object
    Dim rst9 As Object
    Dim rst10 As Object
    
    
    Const xlContinuous As Long = 1
    Const xlThin As Long = 2
    Const xlThick As Long = 5
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlOutsideHorizontal = 12
    
    Set dbs = CurrentDb
    Set xlAp = CreateObject("Excel.Application")
    Set xlWb = xlAp.Workbooks.Open("C:\Users\" & VBA.Environ("username") & "\Desktop\Temp.xltx")
    strSaveAsName = "C:\Users\" & VBA.Environ("username") & "\Desktop\Excel\" & "Sample Inc. " & [Forms]![mgmtfee]![Prod_Cbo] & " " &  Fee Statement " & " - " & [Forms]![mgmtfee]![EndMth_Bx] & " " & [Forms]![mgmtfee]![EndYr_Bx] & ".xlsx"



'=================================================
'-------------------------------------------------
'
'         Details
'
'-------------------------------------------------
'=================================================
    
    
     Set xlws = xlWb.Sheets("Summary")
    
     Set rst1 = dbs.OpenRecordset("Tbl_Individ_Dealer")
      
        With rst1
            .MoveLast
            j = .Fields.Count
            j1 = j - 1
            k = .RecordCount
            ReDim vaHd(j)
            .MoveFirst
            

            For x = 0 To j1
                
           Next
            
            With xlWb
              
              Data = xlws.Cells(4, 2).CopyFromRecordset(rst1)
          
          
           With xlws
           Set rngdata = xlws.Range("B4").CurrentRegion
                    With rngdata
                    '.Borders(xlEdgeBottom).LineStyle = xlContinuous
                    '.Borders(xlEdgeBottom).Weight = xlThick
                    '.Borders(xlEdgeLeft).LineStyle = xlContinuous
                    '.Borders(xlEdgeLeft).Weight = xlThick
                    '.Borders(xlEdgeRight).LineStyle = xlContinuous
                    '.Borders(xlEdgeRight).Weight = xlThick
                    '.Borders(xlEdgeTop).LineStyle = xlContinuous
                    '.Borders(xlEdgeTop).Weight = xlThick
                    '.Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    '.Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    '.Borders(xlInsideHorizontal).Weight = xlThin
                    '.Borders(xlInsideVertical).LineStyle = xlContinuous
                    '.Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    '.Borders(xlInsideVertical).Weight = xlThin
                    End With
                    
           xlws.Range("B2") = "  " & [Forms]![MgmtFee]![Prod_Cbo] & " " & [Forms]![MgmtFee]![MCoNm_Bx] & " " & " Fee Statement  - " & [Forms]![MgmtFee]![EndMth_Bx] & " " & [Forms]![MgmtFee]![EndYr_Bx]
                        
                        End With

           End With
                   End With
        
    
    Set rst1 = Nothing
    
'=================================================
'-------------------------------------------------
'
'         r Totals
'
'-------------------------------------------------
'=================================================

     Set rst2 = dbs.OpenRecordset("Tbl_Individ_SellTot")
      
        With rst2
            .MoveLast
            j = .Fields.Count
            j1 = j - 1
            ReDim vaHd(j)
            .MoveFirst
            
            lstrow = xlws.Range("B" & ws.Rows.Count).End(-4162).Row
            lstrow2 = xlws.Range("H" & ws.Rows.Count).End(-4162).Row
            lstrow3 = xlws.Range("G" & ws.Rows.Count).End(-4162).Row
           'lstrow = xlws.Cells(xlws.Rows.Count, "B").End(xlUp).Row + 1
           'lstrow2 = xlws.Cells(xlws.Rows.Count, "H").End(xlUp).Row
           'lstrow3 = xlws.Cells(xlws.Rows.Count, "G").End(xlUp).Row
          
            z = lstrow + 2
            aa = lstrow + 1

            For x = 0 To j1
             vaHd(x) = .Fields(x).Name
           Next
            
            With xlWb
            
              xlws.Cells(lstrow + 2, 2).Resize(1, j) = vaHd
              Data = xlws.Cells(lstrow + 3, 2).CopyFromRecordset(rst2)
              xlws.Rows(z).RowHeight = 39
              xlws.Range("B" & aa & ":H" & aa).MergeCells = True
              xlws.Cells(lstrow + 1, 2).Value = "Totals"
          
           End With
                   End With
          
    With xlws
    
    
         Set rngdata = xlws.Cells(lstrow + 3, 2).CurrentRegion
                    With rngdata
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                    
                    End With
                    
    
    End With
    Set rngdata2 = xlws.Range(xlws.Cells(lstrow + 2, 2), xlws.Cells(lstrow + 2, 8))

                    With rngdata2
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                     .Font.Bold = True
                     .Font.Color = vbWhite
                     .Font.Size = 10
                     .Interior.Color = RGB(22, 54, 92)
                     .WrapText = True
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlBottom
                     .FormatConditions.Delete

    Set rngdata3 = xlws.Range(xlws.Cells(lstrow + 1, 2), xlws.Cells(lstrow + 1, 8))

                    With rngdata3
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                     .Font.Bold = True
                     .Font.Color = vbBlack
                     .Font.Size = 12
                     .Interior.Color = RGB(191, 191, 191)
                     .WrapText = True
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlBottom
                     .FormatConditions.Delete

    Set rngdata4 = xlws.Range(xlws.Cells(lstrow3 + 3, 8), xlws.Cells(lstrow3 + 25, 8))
                    With rngdata4
                       .Cells.NumberFormat = "$#,###.00"
                    
    End With

        End With
            
            End With
                    
    Set rst2 = Nothing
    
'=================================================
'-------------------------------------------------
'
'           Company Totals
'
'-------------------------------------------------
'=================================================
    
    
    Set rst3 = dbs.OpenRecordset("Tbl_Individ_MTot")
      
        With rst3
            .MoveLast
            j = .Fields.Count
            j1 = j - 1
            ReDim vaHd(j)
            .MoveFirst
            lstrow = xlws.Cells(xlws.Rows.Count, "B").End(xlUp).Row + 1
            z = lstrow + 2
            aa = lstrow + 1

            For x = 0 To j1
             vaHd(x) = .Fields(x).Name
           Next
            
            With xlWb
            
              xlws.Cells(lstrow + 2, 2).Resize(1, j) = vaHd
              Data = xlws.Cells(lstrow + 3, 2).CopyFromRecordset(rst3)
              'xlws.Rows(z).RowHeight = 39
              xlws.Range("B" & aa & ":G" & aa).MergeCells = True
              xlws.Cells(lstrow + 1, 2).Value = "Company Totals"
          
           End With
                   End With
          
    With xlws
    
    
         Set rngdata = xlws.Cells(lstrow + 3, 2).CurrentRegion
                    With rngdata
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                    End With
                    
    
    End With
    Set rngdata2 = xlws.Range(xlws.Cells(lstrow + 2, 2), xlws.Cells(lstrow + 2, 7))

                    With rngdata2
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                     .Font.Bold = True
                     .Font.Color = vbWhite
                     .Font.Size = 10
                     .Interior.Color = RGB(22, 54, 92)
                     .WrapText = True
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlBottom
                     .FormatConditions.Delete

    Set rngdata3 = xlws.Range(xlws.Cells(lstrow + 1, 2), xlws.Cells(lstrow + 1, 7))

                    With rngdata3
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThick
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThick
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThick
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThick
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Color = RGB(166, 166, 166)
                    .Borders(xlInsideHorizontal).Weight = xlThin
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Color = RGB(166, 166, 166)
                    .Borders(xlInsideVertical).Weight = xlThin
                     .Font.Bold = True
                     .Font.Color = vbBlack
                     .Font.Size = 12
                     .Interior.Color = RGB(191, 191, 191)
                     .WrapText = True
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlBottom
                     .FormatConditions.Delete

                  Set rngdata4 = xlws.Cells(lstrow + 3, 7)
                    With rngdata4
                       .Cells.NumberFormat = "$#,###.##"
    End With
      
        End With

            End With
                    
  
    Set rst3 = Nothing

    
    
Set xlws = Nothing
    
    
xlAp.Visible = True
  
xlWb.Worksheets("Summary").Select


With xlAp
.DisplayAlerts = False


xlWb.SaveAs strSaveAsName, xlOpenXMLWorkbook

.DisplayAlerts = True

End With

ExitFunction:
    If Not xlws Is Nothing Then
      Set xlws = Nothing
    End If
    
    If Not xlWb Is Nothing Then
      Set xlWb = Nothing
    End If

    If Not xlAp Is Nothing Then
      xlAp.Quit
    End If
      
    Exit Sub

ErrorHandler:

If Err.Number = 3021 Then Resume Next Else

    Select Case Err.Number
      Case 0
      Case Else
          MsgBox Err.Number & ": " & Err.Description
          Resume ExitFunction
    End Select
End Sub
Go to the top of the page
 
ADezii
post Jan 27 2020, 06:13 PM
Post#9



Posts: 2,757
Joined: 4-February 07
From: USA, Florida, Delray Beach


  1. With no Explicit Reference to the Excel Object Library and using Late Binding, Excel's Intrinsic Constants will not be recognized.
  2. Base Code:
    CODE
    Dim xlApp As Object
    Dim wkb As Object
    Dim xlws As Object
    Dim rngData As Object
    Dim lngLastRow As Long
    Const conUP = -4162

    Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
    Set wkb = xlApp.Workbooks.Open("C:\Projects\Usher History 2019.xlsm")
    Set xlws = wkb.Worksheets("MAIN")
  3. The following Code will fail because of the xlUp Constant:
    CODE
    lngLastRow = xlws.Cells(xlws.Rows.Count, "B").End(xlUp).Row + 1

    xlws.Cells(lngLastRow, "D").CurrentRegion.Select
  4. The following Code will succeed because of the Declared Constant for xlUp:
    CODE
    lngLastRow = xlws.Cells(xlws.Rows.Count, "B").End(conUP).Row + 1

    xlws.Cells(lngLastRow, "D").CurrentRegion.Select
  5. Hope this helps.
Go to the top of the page
 
th53
post Jan 28 2020, 01:41 PM
Post#10



Posts: 63
Joined: 23-May 13



Thank you for your reply, i have tried the code you have listed and it does not drop the data below the last row. Is there something else i am missing?

Thank you!

CODE
    Dim dbs     As Object
    Dim rst     As Object
    Dim xlAp    As Object
    Dim xlWb    As Object
    Dim xlws    As Object
    Dim i       As Long
    Dim j       As Long
    Dim j1      As Long
    Dim k       As Long
    Dim x       As Long
    Dim lstrow As Long
    Dim lstrow2 As Long
    Dim lstrow3 As Long
    Dim s As Integer
    Dim z As Integer
    Dim aa As Integer
    Dim xx As Integer
    Dim yy As Integer
    Dim v As Long
    Dim vaHd()  As String
    Dim Data
    Dim rngdata As Object
    
   'Dim rngMerge As Range, cell As Range
    

    Dim strName As String
    Dim strSaveAsName As String
    Dim aSQL
    Dim rst1 As Object
    Dim rst2 As Object
    Dim rst3 As Object
    Dim rst4 As Object
    Dim rst5 As Object
    Dim rst6 As Object
    Dim rst7 As Object
    Dim rst8 As Object
    Dim rst9 As Object
    Dim rst10 As Object
    
    Const conUp = -4607
    Const xlContinuous As Long = 1
    Const xlThin As Long = 2
    Const xlThick As Long = 5
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlOutsideHorizontal = 12



     Set rst2 = dbs.OpenRecordset("Tbl_Individ_SellTot")
      
        With rst2
            .MoveLast
            j = .Fields.Count
            j1 = j - 1
            ReDim vaHd(j)
            .MoveFirst
            
           lstrow = xlws.Cells(xlws.Rows.Count, "B").End(conUp).Row
           ' lstrow2 = xlws.Cells("H" & xlsws.Rows.Count).End(conUp).Row
            'lstrow3 = xlws.Cells("G" & xlws.Rows.Count).End(conUp).Row
           'lstrow = xlws.Cells(xlws.Rows.Count, "B").End(xlUp).Row + 1
           'lstrow2 = xlws.Cells(xlws.Rows.Count, "H").End(xlUp).Row
           'lstrow3 = xlws.Cells(xlws.Rows.Count, "G").End(xlUp).Row
          
            z = lstrow + 2
            aa = lstrow + 1

            For x = 0 To j1
            ' vaHd(x) = .Fields(x).Name
           Next
            
            With xlWb
            
              xlws.Cells(lstrow + 2, 2).Resize(1, j) = vaHd
              Data = xlws.Cells(lstrow, 2).CopyFromRecordset(rst2)
              xlws.Rows(z).RowHeight = 39
              xlws.Range("B" & aa & ":H" & aa).MergeCells = True
              xlws.Cells(lstrow + 1, 2).Value = "Selling Totals"
          
           End With
                   End With
Go to the top of the page
 
WildBird
post Jan 28 2020, 02:55 PM
Post#11


UtterAccess VIP
Posts: 3,724
Joined: 19-August 03
From: Auckland, Little Australia


Hi,

The code you have shown is quite hard to read, for my post long weekend roadtripping eyes at least. The With End With blocks dont line up, they arent commented to know which goes with which, lots of variables declared and not used, variables not declared as type e.g. aSQL, rst10. A number of spaces and empty lines in the declarations section and so on. Late binding is only for references that arent usually referenced. In your case, you want to take out Excel. This means you can still use DAO, so recordsets can be declared as DAO.Recordset.

Does the code even compile? variables like xlUp I cant see in your code.




--------------------
Beer, natures brain defragging tool.
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    19th February 2020 - 04:56 AM