Results 1 to 6 of 6
  1. #1
    Kody_Devl is offline Novice
    Windows 10 Access 2016
    Join Date
    Jun 2017
    Posts
    22

    Access VBA to format Excel - Works but only once

    Hi all,



    I have some VBA to automatically format Excel from MS Access. The code works perfectly, but only once. Then next time that I the code, I get errors:


    1. Application-defined or object-defined error (on this - Range("A1:M1").Select )


    2. Object variable or With block variable not set (on this - With Selection.Font)


    If I completely close the Database, not Access, but the database, then re-open, it will run perfectly.


    Why is this happening? and How do I fix it?


    Many Thanks


    Kody_Devl

  2. #2
    ranman256's Avatar
    ranman256 is offline VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    9,521
    we'd need to see the code. cant guess.

  3. #3
    Gicu's Avatar
    Gicu is online now VIP
    Windows 10 Access 2010 32bit
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    4,101
    You probably need to fully qualify your Excel variables:
    https://powerspreadsheets.com/excel-vba-range-object/

    Cheers,
    Vlad
    Vlad Cucinschi
    MS Access Developer
    http://forestbyte.com/

  4. #4
    Kody_Devl is offline Novice
    Windows 10 Access 2016
    Join Date
    Jun 2017
    Posts
    22
    Here is the Procedure

    '**********************************
    Public Sub Format_Excel_Borrower()
    '**********************************
    Dim objExcel As Object
    Dim objFso As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim objWorkbook As Object
    Dim sh As Object
    Dim ColumnCount As Integer
    Dim j, i As Integer
    Dim strFirstShName As String
    Dim strExcel_Date As String
    Dim strBranch As String
    Dim strDate As String


    On Error GoTo err_Handler


    strFirstShName = ""


    strDate = Date


    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False
    objExcel.DisplayAlerts = False


    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFso.GetFolder(Get_DBPath)


    For Each objFile In objFolder.Files
    If objFso.GetExtensionName(objFile.Path) = "xlsx" Then
    Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)

    For Each sh In objWorkbook.Worksheets
    Debug.Print sh.Name

    If sh.Name = "vwExportExcel_1" Then
    Else
    GoTo endfunc
    End If




    With sh.Name
    Range("A1:M1").Select

    With Selection.Font
    .Color = RGB(255, 255, 255)
    End With


    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 192
    .TintAndShade = 0
    .PatternTintAndShade = 0
    End With
    End With


    If sh.UsedRange.Address <> "$A$1" Or sh.Range("A1") <> "" Then
    With sh
    ColumnCount = .Cells(1, 256).End(xlToLeft).Column
    For j = 1 To ColumnCount


    With .Cells(1, j)
    i = Len(.Value)
    If j = 1 Then
    .ColumnWidth = 5
    ElseIf j = 2 Then
    .ColumnWidth = 12
    ElseIf j = 3 Then
    .ColumnWidth = 9
    ElseIf j = 4 Then
    .ColumnWidth = 15
    ElseIf j = 5 Then
    .ColumnWidth = 6
    ElseIf j = 6 Then
    .ColumnWidth = 19
    ElseIf j = 7 Then
    .ColumnWidth = 15
    ElseIf j = 8 Then
    .ColumnWidth = 9
    ElseIf j = 9 Then
    .ColumnWidth = 9
    ElseIf j = 10 Then
    .ColumnWidth = 9
    ElseIf j = 11 Then
    .ColumnWidth = 18
    ElseIf j = 12 Then
    .ColumnWidth = 10
    ElseIf j = 13 Then
    .ColumnWidth = 18
    Else
    .ColumnWidth = 10
    End If

    End With

    'sh.Name

    Next

    'Freeze Pane
    'Range("A2").Select
    'ActiveWindow.FreezePanes = True


    End With




    With sh.Name
    Rows("1:3").EntireRow.Insert

    Range("A1").Font.Bold = True
    Range("A1").Font.Size = 13
    Range("A1").Value = "Mers Reonconcilation"
    Range("A1").Font.Bold = True


    Range("A2").Value = "Compare Borrowers"
    Range("A2").Font.Bold = True
    Range("A2").Font.Size = 13


    strDate = "Date: " & strDate
    Range("A3").Value = strDate
    Range("A3").Font.Size = 12
    Range("A3").Font.Bold = True
    End With

    End If

    MoveToNextSheet:
    Next ' Moves to the Next Sheet

    objWorkbook.Worksheets(1).Select
    objWorkbook.Close True

    End If
    Next




    endfunc:




    objExcel.Quit



    If Not objWorkbook Is Nothing Then
    Set objWorkbook = Nothing
    End If

    ' Same goes for quitting the application
    If Not objExcel Is Nothing Then
    objExcel.Quit
    Set objExcel = Nothing
    End If




    Exit Sub
    err_Handler:


    Debug.Print Err.Description


    Resume Next


    End Sub

  5. #5
    Kody_Devl is offline Novice
    Windows 10 Access 2016
    Join Date
    Jun 2017
    Posts
    22
    Here is the Sub

    '**********************************
    Public Sub Format_Excel_Borrower()
    '**********************************
    Dim objExcel As Object
    Dim objFso As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim objWorkbook As Object
    Dim sh As Object
    Dim ColumnCount As Integer
    Dim j, i As Integer
    Dim strFirstShName As String
    Dim strExcel_Date As String
    Dim strBranch As String
    Dim strDate As String


    On Error GoTo err_Handler


    strFirstShName = ""


    strDate = Date


    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False
    objExcel.DisplayAlerts = False


    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFso.GetFolder(Get_DBPath)


    For Each objFile In objFolder.Files
    If objFso.GetExtensionName(objFile.Path) = "xlsx" Then
    Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)

    For Each sh In objWorkbook.Worksheets
    Debug.Print sh.Name

    If sh.Name = "vwExportExcel_1" Then
    Else
    GoTo endfunc
    End If




    With sh.Name
    Range("A1:M1").Select

    With Selection.Font
    .Color = RGB(255, 255, 255)
    End With


    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 192
    .TintAndShade = 0
    .PatternTintAndShade = 0
    End With
    End With


    If sh.UsedRange.Address <> "$A$1" Or sh.Range("A1") <> "" Then
    With sh
    ColumnCount = .Cells(1, 256).End(xlToLeft).Column
    For j = 1 To ColumnCount


    With .Cells(1, j)
    i = Len(.Value)
    If j = 1 Then
    .ColumnWidth = 5
    ElseIf j = 2 Then
    .ColumnWidth = 12
    ElseIf j = 3 Then
    .ColumnWidth = 9
    ElseIf j = 4 Then
    .ColumnWidth = 15
    ElseIf j = 5 Then
    .ColumnWidth = 6
    ElseIf j = 6 Then
    .ColumnWidth = 19
    ElseIf j = 7 Then
    .ColumnWidth = 15
    ElseIf j = 8 Then
    .ColumnWidth = 9
    ElseIf j = 9 Then
    .ColumnWidth = 9
    ElseIf j = 10 Then
    .ColumnWidth = 9
    ElseIf j = 11 Then
    .ColumnWidth = 18
    ElseIf j = 12 Then
    .ColumnWidth = 10
    ElseIf j = 13 Then
    .ColumnWidth = 18
    Else
    .ColumnWidth = 10
    End If

    End With

    'sh.Name

    Next

    'Freeze Pane
    'Range("A2").Select
    'ActiveWindow.FreezePanes = True


    End With




    With sh.Name
    Rows("1:3").EntireRow.Insert

    Range("A1").Font.Bold = True
    Range("A1").Font.Size = 13
    Range("A1").Value = "Mers Reonconcilation"
    Range("A1").Font.Bold = True


    Range("A2").Value = "Compare Borrowers"
    Range("A2").Font.Bold = True
    Range("A2").Font.Size = 13


    strDate = "Date: " & strDate
    Range("A3").Value = strDate
    Range("A3").Font.Size = 12
    Range("A3").Font.Bold = True
    End With

    End If

    MoveToNextSheet:
    Next ' Moves to the Next Sheet

    objWorkbook.Worksheets(1).Select
    objWorkbook.Close True

    End If
    Next




    endfunc:




    objExcel.Quit



    If Not objWorkbook Is Nothing Then
    Set objWorkbook = Nothing
    End If

    ' Same goes for quitting the application
    If Not objExcel Is Nothing Then
    objExcel.Quit
    Set objExcel = Nothing
    End If




    Exit Sub
    err_Handler:


    Debug.Print Err.Description


    Resume Next


    End Sub
    Last edited by Kody_Devl; 01-22-2021 at 09:51 AM.

  6. #6
    Gicu's Avatar
    Gicu is online now VIP
    Windows 10 Access 2010 32bit
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    4,101
    Please try this updated version:
    Code:
    
    '**********************************
    Public Sub Format_Excel_Borrower()
    '**********************************
    Dim objExcel As Object
    Dim objFso As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim objWorkbook As Object
    Dim sh As Object
    Dim ColumnCount As Integer
    Dim j, i As Integer
    Dim strFirstShName As String
    Dim strExcel_Date As String
    Dim strBranch As String
    Dim strDate As String
    
    
    On Error GoTo err_Handler
    
    
    strFirstShName = ""
    
    
    strDate = Date
    
    
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False
    objExcel.DisplayAlerts = False
    
    
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFso.GetFolder(Get_DBPath)
    
    
    For Each objFile In objFolder.Files
    If objFso.GetExtensionName(objFile.Path) = "xlsx" Then
    Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)
    
    
    For Each sh In objWorkbook.Worksheets
    Debug.Print sh.Name
    
    
    If sh.Name = "vwExportExcel_1" Then
    Else
    GoTo endfunc
    End If
    
    
    With sh     '.Name
     .Range("A1:M1").Select
        With Selection.Font
           .Color = RGB(255, 255, 255)   
        End With 
    
    
        With Selection.Interior
           .Pattern = xlSolid
           .PatternColorIndex = xlAutomatic
           .Color = 192
           .TintAndShade = 0
           .PatternTintAndShade = 0
        End With
    End With
    
    
    
    
    If sh.UsedRange.Address <> "$A$1" Or sh.Range("A1") <> "" Then
    With sh
    ColumnCount = .Cells(1, 256).End(xlToLeft).Column
    For j = 1 To ColumnCount
    
    
    
    
    With .Cells(1, j)
    i = Len(.Value)
    If j = 1 Then
    .ColumnWidth = 5
    ElseIf j = 2 Then
    .ColumnWidth = 12
    ElseIf j = 3 Then
    .ColumnWidth = 9
    ElseIf j = 4 Then
    .ColumnWidth = 15
    ElseIf j = 5 Then
    .ColumnWidth = 6
    ElseIf j = 6 Then
    .ColumnWidth = 19
    ElseIf j = 7 Then
    .ColumnWidth = 15
    ElseIf j = 8 Then
    .ColumnWidth = 9
    ElseIf j = 9 Then
    .ColumnWidth = 9
    ElseIf j = 10 Then
    .ColumnWidth = 9
    ElseIf j = 11 Then
    .ColumnWidth = 18
    ElseIf j = 12 Then
    .ColumnWidth = 10
    ElseIf j = 13 Then
    .ColumnWidth = 18
    Else
    .ColumnWidth = 10
    End If
    
    
    End With
    
    
    'sh.Name
    
    
    Next
    
    
    'Freeze Pane
    'Range("A2").Select
    'ActiveWindow.FreezePanes = True
    
    
    End With
    
    
    With sh        '.Name Vlad
       .Rows("1:3").EntireRow.Insert
       .Range("A1").Font.Bold = True
       .Range("A1").Font.Size = 13
       .Range("A1").Value = "Mers Reonconcilation"
       .Range("A1").Font.Bold = True
    
    
       .Range("A2").Value = "Compare Borrowers"
       .Range("A2").Font.Bold = True
       .Range("A2").Font.Size = 13
    
    
    
    
        strDate = "Date: " & strDate
       .Range("A3").Value = strDate
       .Range("A3").Font.Size = 12
       .Range("A3").Font.Bold = True
    End With
    
    
    End If
    
    
    MoveToNextSheet:
    Next ' Moves to the Next Sheet
    
    
    objWorkbook.Worksheets(1).Select
    objWorkbook.Close True
    
    
    End If
    Next
    
    
    endfunc:
    
    
    objExcel.Quit
    
    
    If Not objWorkbook Is Nothing Then
    Set objWorkbook = Nothing
    End If
    
    
    ' Same goes for quitting the application
    If Not objExcel Is Nothing Then
    objExcel.Quit
    Set objExcel = Nothing
    End If
    
    
    Exit Sub
    err_Handler:
    
    
    Debug.Print Err.Description
    
    
    Resume Next
    
    
    End Sub
    Cheers,
    Vlad
    Vlad Cucinschi
    MS Access Developer
    http://forestbyte.com/

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 1
    Last Post: 10-18-2020, 10:00 AM
  2. format of Excel to Access
    By Erictsang in forum Access
    Replies: 1
    Last Post: 10-04-2017, 04:57 AM
  3. Replies: 22
    Last Post: 01-27-2016, 02:35 PM
  4. Replies: 1
    Last Post: 06-21-2015, 07:58 AM
  5. Replies: 4
    Last Post: 12-17-2012, 01:21 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums