Solved Problem closing excel (1 Viewer)

W

wackywoo105

Registered User.
Local time
Today, 12:06
Joined
Mar 14, 2014
Messages
203
I have some access vba code that pulls data from and excel spreadsheet. The problem is after it runs excel is still open in the background, so I must kill it via task manager. I’ve tried a couple of ways to close excel, which I use elsewhere in code and it works fine. Does anyone know how to close properly and fully close excel.


Code: 
Dim desstock As String
desstock = "C:\stocklist.xlsx"

Dim oXLApp As excel.Application      'Declare the object variables
Dim oXLBook As excel.Workbook
Dim oXLSheet As excel.Worksheet
Set oXLApp = New excel.Application   'Create a new instance of Excel
oXLApp.Visible = False

Set oXLBook = oXLApp.Workbooks.Open(desstock) 'Open an existing workbook
Dim Ret As Boolean
Dim LastRow As Integer
Dim overallcount As Integer
Dim inputoutput As String


For Each oXLSheet In oXLBook.Sheets
    If UCase(oXLSheet.Name) = "PriceList" Then
        Set oXLSheet = oXLBook.Worksheets("PriceList")
        oXLApp.DisplayAlerts = False
        oXLSheet.Delete
        oXLApp.DisplayAlerts = True
        Exit For
    End If
Next

*/ DO STUFF  /*

oXLBook.Save
oXLBook.Close True
Set oXLBook = Nothing
oXLApp.Quit                        'Close (and disconnect from) Excel
Set oXLSheet = Nothing
             'Disconnect from Excel (let the user take over)
Set oXLApp = Nothing
If (Environ$("Username")) = "mypc" Then
    Call Shell("taskkill /f /im excel.exe")
End If

Also tried

Code: 
oXLApp.DisplayAlerts = False
Set oXLSheet = Nothing
Set oXLBook = Nothing               'Disconnect from Excel (let the user take over)
oXLApp.Quit                        'Close (and disconnect from) Excel
Set oXLApp = Nothing
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 03:06
Joined
May 7, 2009
Messages
19,245
set sheet object to nothing (set oXLSheet = Nothing)
close workbook and save (oXlBook.Close, True)
set workbook to nothing (set oXlBook = Nothing)
quit the app (oXlApp.Quit)
set it to nothing (Set oXlApp = Nothing)

you can also create a Static Object so it will get close when you close your db.

Code: 
Public Function XLApp() As Excel.Application
Static o As Excel.Application
If o is nothing then
    set o = New Excel.Application
End If
Set XLApp = o
End Function

on your code...

Set oXLApp =XLApp()
 
cheekybuddha

cheekybuddha

AWF VIP
Local time
Today, 20:06
Joined
Jul 21, 2014
Messages
2,280
Post your code for */ DO STUFF /*

It's likely you have an unqualified reference to an Excel object which will be the cause of the hanging instance in memory
 
W

wackywoo105

Registered User.
Local time
Today, 12:06
Joined
Mar 14, 2014
Messages
203
Please excuse my code, but this is the */ DO STUFF /* bit. It takes values from the spreadsheet and creates a table in a word documents. I can run it with selection box called "PriceListSale" ticked or unticked which will use slightly different data. There is probably a much better way to do this than I have used.

I tried the code above but sadly excel still remains open in task amanger.

Code: 
With oXLBook
    .Sheets.Add(After:=.Sheets(.Sheets.count)).Name = "PriceList"
End With
Set oXLSheet = oXLBook.Worksheets("PriceList")
oXLSheet.Cells(1, 1).Value = "Brand"
oXLSheet.Cells(1, 2).Value = "Pre Code"
oXLSheet.Cells(1, 3).Value = "Model"
oXLSheet.Cells(1, 4).Value = "Size"
oXLSheet.Cells(1, 5).Value = "Colour Code"
oXLSheet.Cells(1, 6).Value = "Sell For"
oXLSheet.Cells(1, 7).Value = "Over NHS Voucher"
oXLSheet.Cells(1, 9).Value = "Cost Price"
oXLSheet.Range("A1:I1").Font.Bold = True

       'brand, precode, if sale
one = "M Kors,MK,yes"
two = "M Kors Sun,MK,no"
three = "Ray-Ban Adult,RB,yes"
four = "Ray-Ban Kids,RB,no"
five = "Ray-Ban Sun,RB,no"
six = "Armani,EA,yes"
seven = "Vogue,VO,yes"
eight = "Mango,MNG,yes"
Dim brand As String
Dim precode As String
overallcount = 1
Dim firstpass As Boolean
firstpass = True
Dim firstdata As Boolean
Dim v As Variant

Dim sale As String
Dim sale1 As Integer
Dim sale2 As Integer
  
For Each st In Array(one, two, three, four, five, six, seven, eight)
v = Split(st, ",")
brand = v(0)
precode = v(1)
sale = v(2)

Ret = False
For Each oXLSheet In oXLBook.Sheets
    If UCase(oXLSheet.Name) = brand Then
        Ret = True
        Exit For
    End If
Next

firstdata = True

If Ret = True Then
    Set oXLSheet = oXLBook.Worksheets(brand)
    LastRow = oXLSheet.UsedRange.Rows.count + 1

   'sort ascending
    oXLBook.Worksheets(brand).Sort.SortFields.Clear
    oXLBook.Worksheets(brand).Sort.SortFields.add2 Key:=Range( _
        "F3:F" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With oXLBook.Worksheets(brand).Sort
        .SetRange Range("A3:AP" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With



    For counter = 3 To LastRow
        Set oXLSheet = oXLBook.Worksheets(brand)
        If oXLSheet.Cells(counter, 22).Value = "" And oXLSheet.Cells(counter, 23).Value = "" And Not oXLSheet.Cells(counter, 5).Value Like "" Then
        If firstdata = True Then
            firstdata = False
            If firstpass = True Then
                firstpass = False
                overallcount = overallcount + 1
            Else
                overallcount = overallcount + 2
            End If
          
        Else
            overallcount = overallcount + 1
        End If
          
            For x = 4 To 6 'brand, pre code and model
                Set oXLSheet = oXLBook.Worksheets(brand)
                inputoutput = oXLSheet.Cells(counter, x).Value
                Set oXLSheet = oXLBook.Worksheets("PriceList")
                oXLSheet.Cells(overallcount, x - 3).Value = inputoutput
            Next x
          
            oXLSheet.Cells(overallcount, 2).Value = precode ' change pre code to my version
          
            Set oXLSheet = oXLBook.Worksheets(brand) 'size
            inputoutput = oXLSheet.Cells(counter, 8).Value
            Set oXLSheet = oXLBook.Worksheets("PriceList")
            oXLSheet.Cells(overallcount, 4).Value = inputoutput
          
            Set oXLSheet = oXLBook.Worksheets(brand) 'colour
            inputoutput = oXLSheet.Cells(counter, 9).Value
            Set oXLSheet = oXLBook.Worksheets("PriceList")
            oXLSheet.Cells(overallcount, 5).Value = inputoutput
          
          
If PriceListSale = True And sale Like "yes" Then
    sale1 = 28
    sale2 = 30
Else
    sale1 = 17
    sale2 = 19
End If
          
            Set oXLSheet = oXLBook.Worksheets(brand) '17 = sell for, sale = 28
            inputoutput = oXLSheet.Cells(counter, sale1).Value
            Set oXLSheet = oXLBook.Worksheets("PriceList")
            oXLSheet.Cells(overallcount, 6).Value = inputoutput
          
            Set oXLSheet = oXLBook.Worksheets(brand) '19 = over voucher, sale = 30
            inputoutput = oXLSheet.Cells(counter, sale2).Value
            Set oXLSheet = oXLBook.Worksheets("PriceList")
            oXLSheet.Cells(overallcount, 7).Value = inputoutput
          
          
            Set oXLSheet = oXLBook.Worksheets(brand) 'cost price not inc glazing
            inputoutput = oXLSheet.Cells(counter, 12).Value
            Set oXLSheet = oXLBook.Worksheets("PriceList")
            oXLSheet.Cells(overallcount, 9).Value = inputoutput
          
            'Debug.Print Counter & "____" & LastRow

        
        End If
    Next counter
  
        oXLBook.Worksheets(brand).Sort.SortFields.Clear
    oXLBook.Worksheets(brand).Sort.SortFields.add2 Key:=Range( _
        "U3:U" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With oXLBook.Worksheets(brand).Sort
        .SetRange Range("A3:AP" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  
  
        oXLBook.Worksheets(brand).Sort.SortFields.Clear
    oXLBook.Worksheets(brand).Sort.SortFields.add2 Key:=Range( _
        "V3:V" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With oXLBook.Worksheets(brand).Sort
        .SetRange Range("A3:AP" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  
            oXLBook.Worksheets(brand).Sort.SortFields.Clear
    oXLBook.Worksheets(brand).Sort.SortFields.add2 Key:=Range( _
        "W3:W" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With oXLBook.Worksheets(brand).Sort
        .SetRange Range("A3:AP" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  
  

'MsgBox oXLSheet("Test").Cells(1, 4).Value

Else
MsgBox brand & " not there"
End If

Next st

oXLApp.DisplayAlerts = False


'put word code here
   Set oXLSheet = oXLBook.Worksheets("PriceList")

   Dim objWord
   Dim objDoc
   Dim objRange
   Dim objTable

  Set objWord = CreateObject("Word.Application")
  If PriceListSale = True Then
     Set objDoc = objWord.Documents.Open(gdrive & "Designer Frame Pricing SALE.docx", Visible:=False)
  Else
      Set objDoc = objWord.Documents.Open(gdrive & "Designer Frame Pricing.docx", Visible:=False)
  End If
  objWord.Visible = True
'  Set objDoc = objWord.Documents.Add
  Set objRange = objDoc.Range

If objDoc.Tables.count <> 0 Then
    objDoc.Tables(1).Delete
End If

Set objRange = objDoc.Range.Bookmarks("tablehere").Range

  objDoc.Tables.Add objRange, overallcount, 7
  Set objTable = objDoc.Tables(1)

  For i = 1 To overallcount
     For j = 1 To 7
objTable.Cell(i, j).Range.Text = oXLSheet.Cells(i, j).Value
     Next
  Next


  With objTable
    .Borders.Enable = True
    .Columns(1).Width = CentimetersToPoints(4)
'  .Columns(2).Width = CentimetersToPoints(4.24)
    .Columns(2).Width = CentimetersToPoints(2)
    .Columns(3).Width = CentimetersToPoints(2)
    .Columns(4).Width = CentimetersToPoints(2)
    .Columns(5).Width = CentimetersToPoints(2.34)
    .Columns(6).Width = CentimetersToPoints(2)
    .Columns(7).Width = CentimetersToPoints(2.75)
    '.Rows.Height = CentimetersToPoints(0.4)
    .Rows.HeightRule = wdRowHeightAuto
    .Range.Font.Size = 14
    .Range.Font.Name = "Trebuchet MS"
    .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
   ' .Range.Font.Bold = True
  End With


'objDoc.saveas filename:="C:\Users\mypc\Desktop\price list fully auto\Designer Frame Pricing.docx"
If PriceListSale = True Then
objDoc.saveas filename:=gdrive & "Designer Frame Pricing SALE.docx"
Else
objDoc.saveas filename:=gdrive & "Designer Frame Pricing.docx"
End If
objWord.Quit
Set objWord = Nothing
'end word code

On Error Resume Next
          
If PriceListSale = True Then
    If (Environ$("Username")) = "Admin" Then oXLBook.saveas ("C:\Users\Admin\OneDrive\PriceListSALE.xlsx")
    If (Environ$("Username")) = "mypc" Then oXLBook.saveas ("C:\Users\mypc\OneDrive\PriceListSALE.xlsx")
Else
     If (Environ$("Username")) = "Admin" Then oXLBook.saveas ("C:\Users\Admin\OneDrive\PriceListNORMAL.xlsx")
     If (Environ$("Username")) = "mypc" Then oXLBook.saveas ("C:\Users\mypc\OneDrive\PriceListNORMAL.xlsx")
End If
 
Last edited:
cheekybuddha

cheekybuddha

AWF VIP
Local time
Today, 20:06
Joined
Jul 21, 2014
Messages
2,280
OK, here are the ones I've found so far:
Code: 
' ...
    oXLBook.Worksheets(brand).Sort.SortFields.add2 Key:=Range( _
        "F3:F" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With oXLBook.Worksheets(brand).Sort
        .SetRange Range("A3:AP" & LastRow)
' ...
Replace with:
Code: 
' ...
    oXLBook.Worksheets(brand).Sort.SortFields.add2 Key:=oXLBook.Worksheets(brand).Range( _
        "F3:F" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With oXLBook.Worksheets(brand).Sort
        .SetRange oXLBook.Worksheets(brand).Range("A3:AP" & LastRow)
' ...

Then:
Code: 
' ...
    Next counter
  
        oXLBook.Worksheets(brand).Sort.SortFields.Clear
    oXLBook.Worksheets(brand).Sort.SortFields.add2 Key:=Range( _
        "U3:U" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With oXLBook.Worksheets(brand).Sort
        .SetRange Range("A3:AP" & LastRow)
' ...
Replace with:
Code: 
' ...
    Next counter
  
        oXLBook.Worksheets(brand).Sort.SortFields.Clear
    oXLBook.Worksheets(brand).Sort.SortFields.add2 Key:=oXLBook.Worksheets(brand).Range( _
        "U3:U" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With oXLBook.Worksheets(brand).Sort
        .SetRange oXLBook.Worksheets(brand).Range("A3:AP" & LastRow)
' ...

There is a lot of code to scan and my eyes are hurting as a result!

Change those instances and see if it stops the hanging instance issue. If not, further hunting required!
 
W

wackywoo105

Registered User.
Local time
Today, 12:06
Joined
Mar 14, 2014
Messages
203
Thanks. I changed the ones you listed and a couple of others and it now works. I wish I knew why?

Many thanks for your help.
 
cheekybuddha

cheekybuddha

AWF VIP
Local time
Today, 20:06
Joined
Jul 21, 2014
Messages
2,280
wackywoo105 said:
I wish I knew why?
Click to expand...
The issue is caused by using an unqualified reference to an Excel object.

That is, you use an Excel class without accessing it through your own oXLApp instance. What happens is that Excel creates a new instance of the class (much like if you were to use an undeclared variable without Option Explicit) whose object pointer remains orphaned after you destroy the references to the Excel objects you created and thus the whole Excel instance remains in memory with no way of cleaning up that object.

This was reported to MS many many years ago, but IIRC they decided it was a feature and not a bug :rolleyes: (probably it was too difficult to fix!).

In your case, you have used an unqualified reference to the Range object:
Code: 
' ...
'                                                       Here
'                                                         |
'                                                         v
    oXLBook.Worksheets(brand).Sort.SortFields.add2 Key:=Range( _
        "F3:F" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With oXLBook.Worksheets(brand).Sort
        .SetRange Range("A3:AP" & LastRow)
'                   ^
'                   |
'               and Here
' ...
You must reference your Range via your Worksheet object:
Code: 
oXLBook.Worksheets(brand).Range("F3:F" & LastRow),

Since you are using a With block for the same worksheet's .Sort object directly after the first reference you may as well combine it within the same With block:
Code: 
' ...
    With oXLBook.Worksheets(brand)
        .Sort.SortFields.Clear
        .Sort.SortFields.add2 _
          Key:=.Range("F3:F" & LastRow), _
          SortOn:=xlSortOnValues, _
          Order:=xlAscending, _
          DataOption:=xlSortNormal
'             The dot here links it to your worksheet (same above)
'                      |
'                      v
        .Sort.SetRange .Range("A3:AP" & LastRow)
       With .Sort
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
      End With
End With
' ...

Separately, you might be better off setting a separate worksheet object variable for the PriceList sheet at the beginning to avoid having to switch you oXLSheet variable continuously.
 
cheekybuddha

cheekybuddha

AWF VIP
Local time
Today, 20:06
Joined
Jul 21, 2014
Messages
2,280
I refactored your code a little bit - of course it's untested and I did it in a text editor, so not even sure it will compile, but hopefully it's a little clearer!
Code: 
Dim desstock As String
desstock = "C:\stocklist.xlsx"

Dim oXLApp As Excel.Application      'Declare the object variables
Dim oXLBook As Excel.Workbook
Dim oXLPriceList As Excel.Worksheet
Dim oXLBrand As Excel.Worksheet
Set oXLApp = New Excel.Application   'Create a new instance of Excel
oXLApp.Visible = False

Set oXLBook = oXLApp.Workbooks.Open(desstock) 'Open an existing workbook
Dim Ret As Boolean
Dim LastRow As Integer
Dim overallcount As Integer
Dim inputoutput As String


For Each oXLSheet In oXLBook.Sheets
    With oXLSheet
        If .Name = "PriceList" Then
            oXLApp.DisplayAlerts = False
            .Delete
            oXLApp.DisplayAlerts = True
            Exit For
        End If
    End With
Next

With oXLBook
    .Sheets.Add(After:=.Sheets(.Sheets.count)).Name = "PriceList"
End With
Set oXLPriceList = oXLBook.Sheets.Add(After:=.Sheets(.Sheets.count))
With oXLPriceList
    .Name = "PriceList"
    .Cells(1, 1).Value = "Brand"
    .Cells(1, 2).Value = "Pre Code"
    .Cells(1, 3).Value = "Model"
    .Cells(1, 4).Value = "Size"
    .Cells(1, 5).Value = "Colour Code"
    .Cells(1, 6).Value = "Sell For"
    .Cells(1, 7).Value = "Over NHS Voucher"
    .Cells(1, 9).Value = "Cost Price"
    .Range("A1:I1").Font.Bold = True
End With 

       'brand, precode, if sale
one = "M Kors,MK,yes"
two = "M Kors Sun,MK,no"
three = "Ray-Ban Adult,RB,yes"
four = "Ray-Ban Kids,RB,no"
five = "Ray-Ban Sun,RB,no"
six = "Armani,EA,yes"
seven = "Vogue,VO,yes"
eight = "Mango,MNG,yes"
Dim brand As String
Dim precode As String
overallcount = 1
Dim firstpass As Boolean
firstpass = True
Dim firstdata As Boolean
Dim v As Variant

Dim sale As String
Dim sale1 As Integer
Dim sale2 As Integer

For Each st In Array(one, two, three, four, five, six, seven, eight)
    v = Split(st, ",")
    brand = v(0)
    precode = v(1)
    sale = v(2)

    Ret = False
    For Each oXLBrand In oXLBook.Sheets
        If oXLBrand.Name = brand Then
            Ret = True
            Exit For
        End If
    Next

    firstdata = True

    If Ret = True Then
        Set oXLBrand = oXLBook.Worksheets(brand)
        With oXLBrand
            LastRow = .UsedRange.Rows.count + 1
            'sort ascending
            .Sort.SortFields.Clear
            .Sort.SortFields.add2 _
                Key:=.Range("F3:F" & LastRow), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                DataOption:= xlSortNormal
            .Sort.SetRange .Range("A3:AP" & LastRow)
            With .Sort
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            For counter = 3 To LastRow
                If .Cells(counter, 22).Value = "" And .Cells(counter, 23).Value = "" And Not .Cells(counter, 5).Value Like "" Then
                    If firstdata = True Then
                        firstdata = False
                        If firstpass = True Then
                            firstpass = False
                            overallcount = overallcount + 1
                        Else
                            overallcount = overallcount + 2
                        End If
                    Else
                        overallcount = overallcount + 1
                    End If

                    For x = 4 To 6 'brand, pre code and model
                        inputoutput = .Cells(counter, x).Value
                        oXLPriceList.Cells(overallcount, x - 3).Value = inputoutput
                    Next x

                    oXLPriceList.Cells(overallcount, 2).Value = precode ' change pre code to my version
                    inputoutput = .Cells(counter, 8).Value
                    oXLPriceList.Cells(overallcount, 4).Value = inputoutput
                    inputoutput = .Cells(counter, 9).Value
                    oXLPriceList.Cells(overallcount, 5).Value = inputoutput
                      
                    If PriceListSale = True And sale Like "yes" Then
                        sale1 = 28
                        sale2 = 30
                    Else
                        sale1 = 17
                        sale2 = 19
                    End If
          
                    inputoutput = .Cells(counter, sale1).Value '17 = sell for, sale = 28
                    oXLPriceList.Cells(overallcount, 6).Value = inputoutput
              
                    inputoutput = .Cells(counter, sale2).Value '19 = over voucher, sale = 30
                    oXLPriceList.Cells(overallcount, 7).Value = inputoutput
          
                    inputoutput = .Cells(counter, 12).Value 'cost price not inc glazing
                    oXLPriceList.Cells(overallcount, 9).Value = inputoutput
          
                'Debug.Print Counter & "____" & LastRow
                End If
            Next counter
  
            .Sort.SortFields.Clear
            .Sort.SortFields.add2 _
                Key:=.Range("U3:U" & LastRow), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                DataOption:= xlSortNormal
            .Sort.SetRange .Range("A3:AP" & LastRow)
            With .Sort
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
  
            .Sort.SortFields.Clear
            .Sort.SortFields.add2 _
                Key:=.Range("V3:V" & LastRow), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                DataOption:= xlSortNormal
            .Sort.SetRange .Range("A3:AP" & LastRow)
            With .Sort
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
  
            .Sort.SortFields.Clear
            .Sort.SortFields.add2 _
                Key:=.Range("W3:W" & LastRow), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                DataOption:=xlSortNormal
            .Sort.SetRange .Range("A3:AP" & LastRow)
            With .Sort
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With

        End With
    'MsgBox oXLSheet("Test").Cells(1, 4).Value
    Else
        MsgBox brand & " not there"
    End If

Next st

oXLApp.DisplayAlerts = False


'put word code here
Dim objWord
Dim objDoc
Dim objRange
Dim objTable

Set objWord = CreateObject("Word.Application")
If PriceListSale = True Then
    Set objDoc = objWord.Documents.Open(gdrive & "Designer Frame Pricing SALE.docx", Visible:=False)
Else
    Set objDoc = objWord.Documents.Open(gdrive & "Designer Frame Pricing.docx", Visible:=False)
End If
objWord.Visible = True
'  Set objDoc = objWord.Documents.Add
Set objRange = objDoc.Range

If objDoc.Tables.count <> 0 Then
    objDoc.Tables(1).Delete
End If

Set objRange = objDoc.Range.Bookmarks("tablehere").Range

objDoc.Tables.Add objRange, overallcount, 7
Set objTable = objDoc.Tables(1)

For i = 1 To overallcount
     For j = 1 To 7
        objTable.Cell(i, j).Range.Text = oXLPriceList.Cells(i, j).Value
     Next
Next

With objTable
    .Borders.Enable = True
    .Columns(1).Width = CentimetersToPoints(4)
    '  .Columns(2).Width = CentimetersToPoints(4.24)
    .Columns(2).Width = CentimetersToPoints(2)
    .Columns(3).Width = CentimetersToPoints(2)
    .Columns(4).Width = CentimetersToPoints(2)
    .Columns(5).Width = CentimetersToPoints(2.34)
    .Columns(6).Width = CentimetersToPoints(2)
    .Columns(7).Width = CentimetersToPoints(2.75)
    '.Rows.Height = CentimetersToPoints(0.4)
    .Rows.HeightRule = wdRowHeightAuto
    .Range.Font.Size = 14
    .Range.Font.Name = "Trebuchet MS"
    .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
    ' .Range.Font.Bold = True
End With

'objDoc.saveas filename:="C:\Users\mypc\Desktop\price list fully auto\Designer Frame Pricing.docx"
If PriceListSale = True Then
    objDoc.saveas filename:=gdrive & "Designer Frame Pricing SALE.docx"
Else
    objDoc.saveas filename:=gdrive & "Designer Frame Pricing.docx"
End If
objWord.Quit
Set objWord = Nothing
'end word code

On Error Resume Next
        
If PriceListSale = True Then
    If (Environ$("Username")) = "Admin" Then oXLBook.saveas ("C:\Users\Admin\OneDrive\PriceListSALE.xlsx")
    If (Environ$("Username")) = "mypc" Then oXLBook.saveas ("C:\Users\mypc\OneDrive\PriceListSALE.xlsx")
Else
     If (Environ$("Username")) = "Admin" Then oXLBook.saveas ("C:\Users\Admin\OneDrive\PriceListNORMAL.xlsx")
     If (Environ$("Username")) = "mypc" Then oXLBook.saveas ("C:\Users\mypc\OneDrive\PriceListNORMAL.xlsx")
End If

Set oXLBrand = Nothing
Set oXLPriceList = Nothing
oXLBook.Save
oXLBook.Close True
Set oXLBook = Nothing
oXLApp.Quit                        'Close (and disconnect from) Excel
             'Disconnect from Excel (let the user take over)
Set oXLApp = Nothing
If (Environ$("Username")) = "mypc" Then
    Call Shell("taskkill /f /im excel.exe")
End If
I think you may have some undeclared variables, but hopefully you've declared them in the code you haven't shown us. Otherwise, ensure you have Option Explicit declared at the top of every code module and then in the VBA editor: ToolsMenu->Debug->Compile
 
cheekybuddha

cheekybuddha

AWF VIP
Local time
Today, 20:06
Joined
Jul 21, 2014
Messages
2,280
Did it work?

You can probably reduce your sorting code as well by using a loop.
 
You must log in or register to reply here.

Similar threads

W
Check for open excel workbook and if open take control
2
Replies
23
Views
990
ebs17
E
R
Updating Excel spreadsheet from within the Access
Replies
8
Views
354
CJ_London
C
NauticalGent
Run Excel Trim Function from Access
2
Replies
31
Views
1,029
KitaYama
K
N
Solved Mass Importing Txt Files
Replies
14
Views
405
ebs17
E
T
Solved Append table to excel file
Replies
8
Views
819
ebs17
E

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom