I'm trying to run a macro, but when referencing a excel file I have set up already I am getting a run time error and highlights which references my path. I am almost certain that this path is correct because I went to the properties of the excel file and copied the location
Set xlWB = xlApp.Workbooks.Open(strPath)
' Get Excel set up
enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
Debug.Print strPath = enviro & "\Documents\multipliers.xls"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Test1")
' Process the message record
Your file is a .xlsx file, not .xls as in your code. Change the following line:
strPath = enviro & "\Documents\multipliers.xls"
to:
strPath = enviro & "\Documents\multipliers.xlsx"
Private Sub doingstuff()
Dim xlWB As Workbook
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
strPath = Environ("USERPROFILE") & "\Desktop" & "\" & "Book2" & ".xlsm"
Set xlWB = Workbooks.Open(strPath)
End Sub
this works fine for me.
Related
I'm trying to write a VBA macro from within Word to create an Excel spreadsheet and export data to it. I'm having trouble just creating the new spreadsheet. For the following macro, I get "Object doesn't support this property or method" on the line
Set myWb = myExcel.Workbooks.Add
in the code
Private Sub CreateExcel2()
Dim myExcel As Object
Dim myWb As Object
Set myExcel = CreateObject("Excel.Application")
Set myWb = myExcel.Workbooks.Add
Application.DisplayAlerts = False
myWb.SaveAs FileName:="D:\test\dump.xls"
Application.DisplayAlerts = True
myWb.Close False
Set myWb = Nothing
myExcel.Quit
Set myExcel = Nothing
End Sub
You can try:
On Error Resume Next
Set oExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Err.Clear
Set oExcel = CreateObject("Excel.Application")
End If
On Error GoTo 0
oExcel.visible = true 'to check of excel opens
'try Set myWb = myExcel.Workbooks.Add()
'try Set myWb = oExcel.Workbooks.Open(sPathFile)
What I am trying to do.
I highlight some text in an email then run my macro.
It 'copies' the highlighted text and stores it in variable strText.
Then it creates a file called Artwork List.xlsx if it does not exist and if it exists it opens it.
After that it copies the text into the file in column A row 1 if the lastrow is 1, and if not, it appends to lastrow + 1
My code throws
'Run-time error 424, Object required'
To narrow down, the error should be coming from:
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
or anything related to this line.
Sub copyArts2File()
MsgBox "ok"
Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim strText As String
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim strTextArr As Variant
On Error Resume Next
'Get Outlook if it's running
Set OutApp = GetObject(, "Outlook.Application")
'Outlook wasn't running, so cancel
If Err <> 0 Then
MsgBox "Outlook is not running so nothing can be selected!"
GoTo lbl_Exit
End If
On Error GoTo 0
Set OutMail = OutApp.ActiveExplorer.Selection.Item(1)
With OutMail
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
strText = wdDoc.Application.Selection.Range.Text
End With
'MsgBox strText
lbl_Exit:
Set OutMail = Nothing
Set OutApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
FileName = "Artwork List.xlsx"
fileDoesExist = Dir("C:\Users\quaer\Desktop\DL Arts\" & FileName) > ""
' Check for existing file
If fileDoesExist Then
' Open Excel file
Set xlBook = xlApp.Workbooks.Open("C:\Users\quaer\Desktop\DL Arts\" & FileName)
Set xlSheet = xlBook.Sheets(1)
Else
' Add Excel file
Set xlBook = xlApp.Workbooks.Add
With xlBook
.SaveAs FileName:="C:\Users\quaer\Desktop\DL Arts\" & FileName
End With
Set xlSheet = xlBook.Sheets(1)
End If
' Do stuff with Excel workbook
Dim i As Integer
Dim lastrow As Long
With xlApp
With xlBook
With xlSheet
strTextArr = Split(strText, "Adding file")
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
MsgBox lastrow
If lastrow = 1 Then
For i = 1 To UBound(strTextArr)
.Range("A" & i).Value = strTextArr(i)
Next i
Else
For i = 1 To UBound(strTextArr)
.Range("A" & (i + lastrow)).Value = strTextArr(i)
Next i
End If
.Close SaveChanges:=True
End With
End With
End With
xlApp.Visible = True
Exit Sub
End Sub
Try replacing this line, lastrow = .Cells(Rows.Count, 1).End(xlUp).Row, with:
lastrow = .Cells(1048576, 1).End(xlUp).Row
or
lastrow = .Cells(Rows.Count +1, 1).End(xlUp).Row
Jeeez this is crazy. I have found the problem finally and got a working code for anyone wanting similar usage. 1st off, I need to add the Microsoft excel add in. So in Outlook VBA, Tools -> references -> check Microsoft Excel 16.0 Object Library. This is to get rid of the 424 object required error, as I was trying to a call a excel built in method I guess. this is the line:
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
Pls note that I am calling this macro from Outlook.
After this I faced a couple of other issues.
1. errors such as 424 run time, remote server machine does not exist or is not available.
first time running, it throws this error, 2nd time I click, the problem goes away. This is an issue with non specific use of the app, book and worksheet and so leaves VBA to assign on its own. Lesson learnt, be explicit about every thing.
leaves a copy of excel process even after program ends. This can be seen in task manager. This causes issues because then my excel file is linked to this process and not able to open without either read only or notify. Its locked with the process. So I cannot run again next time.
Anyway. Here is the final code. And I have also changed it to .Range instead of .Cells. I believe it does not matter if I used either but the key culprit is : xlSheet.Rows.Count. Instead of just Rows.Count, explicitly use xlSheet.Rows.Count.
Option Explicit
Sub copyArts2File()
MsgBox "ok"
Dim OutApp As Object, OutMail As Object, olInsp As Object, wdDoc As Object
Dim xlApp As Excel.Application, xlBook As Excel.Workbook, xlSheet As Object
Dim strText As String
Dim strTextArr As Variant
Dim fName As String
Dim fileDoesExist As Boolean
Dim i As Integer
Dim lastrow As Long
On Error Resume Next
'Get Outlook if it's running
Set OutApp = GetObject(, "Outlook.Application")
'Outlook wasn't running, so cancel
If Err <> 0 Then
MsgBox "Outlook is not running so nothing can be selected!"
GoTo lbl_Exit
End If
On Error GoTo 0
Set OutMail = OutApp.ActiveExplorer.Selection.Item(1)
With OutMail
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
strText = wdDoc.Application.Selection.Range.Text
End With
'MsgBox strText
'Close out all shit
Set OutMail = Nothing
Set OutApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
lbl_Exit:
Set OutMail = Nothing
Set OutApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
On Error Resume Next 'Create or use a Excel Application
Set xlApp = GetObject(, "Excel.Application")
If Err.Number > 0 Then Set xlApp = CreateObject("Excel.Application")
On Error GoTo 0
xlApp.Visible = False
xlApp.DisplayAlerts = False
fName = "Artwork List.xlsx"
fileDoesExist = Dir("C:\Users\quaer\Desktop\DL Arts\" & fName) > ""
' Check for existing file
If fileDoesExist Then
' Open Excel file if present
Set xlBook = xlApp.Workbooks.Open("C:\Users\quaer\Desktop\DL Arts\" & fName)
Else
' Add Excel file if not present
Set xlBook = xlApp.Workbooks.Add
xlBook.SaveAs fileName:="C:\Users\quaer\Desktop\DL Arts\" & fName
End If
Set xlSheet = xlBook.Worksheets(1)
' Do stuff with Excel workbook
strTextArr = Split(strText, "Adding file")
lastrow = xlSheet.Range("A" & xlSheet.Rows.Count).End(xlUp).Row
If lastrow = 1 Then
For i = 1 To UBound(strTextArr)
xlSheet.Range("A" & i).Value = strTextArr(i)
Next i
Else
For i = 1 To UBound(strTextArr)
xlSheet.Range("A" & (i + lastrow)).Value = strTextArr(i)
Next i
End If
xlBook.SaveAs fileName:="C:\Users\quaer\Desktop\DL Arts\" & fName, AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
xlBook.Close (True)
Set xlBook = Nothing
Set xlSheet = Nothing
xlApp.Visible = True
xlApp.Quit
Set xlApp = Nothing
MsgBox "Done!"
Exit Sub
End Sub
Thanks for the help and suggestions nonetheless.
I've got an issue with some code when I've tried to install some code on a colleagues machine. The machine and version of Outlook are exactly the same and reference the same libraries. However, when I try and run the script on her machine, it throws up an error 91 on the 'Set xlWB = xlApp.Workbooks.Open(strPath)'.
The intention is to export necessary data from a selected email message into an Excel spreadsheet located in a specified directory.
Any clues as to what I should be trying in order to eliminate the error? First half of the code below.
Many thanks!
Option Explicit
Sub ServiceRequestTool()
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim rCount As Long
Dim bXStarted As Boolean
Dim enviro As String
Dim strPath As String
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim olItem As Outlook.MailItem
Dim obj As Object
Dim strColA, strColB, strColC As String
strPath = "H:\My Documents\General Docs\Govtnz-Service-Request.xlsm"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
If Dir$("H:\My Documents\General Docs\Govtnz-Service-Request.xlsm") = "" Then
MsgBox "Contact the spreadsheet administrator for assistance.", vbOKOnly + vbCritical, "File not found!"
Exit Sub
End If
End If
On Error GoTo 0
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("requestAssignment")
On Error Resume Next
rCount = xlSheet.Range("C" & xlSheet.Rows.Count).End(-4162).Row + 1
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
For Each obj In Selection
Set olItem = obj
strColA = olItem.SenderName
strColB = olItem.SenderEmailAddress
strColC = olItem.ReceivedTime
xlSheet.Range("B" & rCount) = strColC
xlSheet.Range("C" & rCount) = strColA
xlSheet.Range("D" & rCount) = strColB
rCount = rCount + 1
Next
xlWB.Close 1
If bXStarted Then
xlApp.Quit
End If
Set olItem = Nothing
Set obj = Nothing
Set currentExplorer = Nothing
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
End Sub
You are most probably getting that error because there is no instance of Excel which is running.
You need to create a new instance when GetObject doesn't find one.
You are checking for the existence of the file if Err <> 0? i.e when no Excel instance is found? That doesn't make sense. Check for the existence of the file first and then check for Excel.
Is this what you are trying? (untested)
Change your code
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
If Dir$("H:\My Documents\General Docs\Govtnz-Service-Request.xlsm") = "" Then
MsgBox "Contact the spreadsheet administrator for assistance.", _
vbOKOnly + vbCritical, "File not found!"
Exit Sub
End If
End If
On Error GoTo 0
to
'~~> Move ths out of that IF/EndIf
If Dir$("H:\My Documents\General Docs\Govtnz-Service-Request.xlsm") = "" Then
MsgBox "Contact the spreadsheet administrator for assistance.", _
vbOKOnly + vbCritical, "File not found!"
Exit Sub
End If
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Set xlApp = CreateObject("Excel.Application") '<~~ Add this line
End If
On Error GoTo 0
If xlApp Is Nothing Then
MsgBox "Excel is not installed"
Exit Sub
End If
I'm trying to open an Excel file from Access and do some stuff with It, but code is not stable. Sometimes It works, other times not. Here's how I do this:
Dim FilePath As String
Dim ExcelApp As Excel.Application
FilePath = "C:\Users\Lucky\Desktop\Test.xls"
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Workbooks.Open (FilePath)
With ExcelApp
'do some stuff here
End With
ExcelApp.Workbooks.Close
Set ExcelApp = Nothing
I've also noticed that once I run code, Excel starts proccess under Task Manager, that has to be killed manually in order to get code working again. Otherwise I get two types of error with Excel file:
one is that If I click Excel file, It doesn't open, It just flashes for a second and dissapears
and other is that Excel file opens in "read-only" mode...
So I reckon there is some flaw when file is closed in my code. How can I fix this ?
I can't see what's wrong with your code - maybe the path to the desktop?
This is the code I usually use - I've added another function to help choose the file. It uses late binding, so no need to set a reference to Excel - you don't get the IntelliSense and can't use Excel constants such as xlUp - you have to use the numerical equivalent.
Public Sub Test()
Dim oXLApp As Object
Dim oXLWrkBk As Object
Dim oXLWrkSht As Object
Dim vFile As Variant
Dim lLastRow As Long
vFile = GetFile()
Set oXLApp = CreateXL
Set oXLWrkBk = oXLApp.WorkBooks.Open(vFile, False)
Set oXLWrkSht = oXLWrkBk.WorkSheets(1) 'First sheet. Can also use "Sheet1", etc...
lLastRow = oXLWrkSht.Cells(oXLWrkSht.Rows.Count, "A").End(-4162).Row '-4162 = xlUp
MsgBox "Last row in column A is " & lLastRow
oXLWrkBk.Close False
oXLApp.Quit
Set oXLWrkBk = Nothing
Set oXLApp = Nothing
End Sub
Public Function CreateXL(Optional bVisible As Boolean = True) As Object
Dim oTmpXL As Object
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Defer error trapping in case Excel is not running. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Set oTmpXL = GetObject(, "Excel.Application")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'If an error occurs then create an instance of Excel. '
'Reinstate error handling. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Err.Number <> 0 Then
Err.Clear
On Error GoTo ERROR_HANDLER
Set oTmpXL = CreateObject("Excel.Application")
End If
oTmpXL.Visible = bVisible
Set CreateXL = oTmpXL
On Error GoTo 0
Exit Function
ERROR_HANDLER:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure CreateXL."
Err.Clear
End Select
End Function
Function GetFile(Optional startFolder As Variant = -1, Optional sFilterName As String = "") As Variant
Dim fle As Object
Dim vItem As Variant
'''''''''''''''''''''''''''''''''''''''''''
'Clear the file filter and add a new one. '
'''''''''''''''''''''''''''''''''''''''''''
Application.FileDialog(3).Filters.Clear
Application.FileDialog(3).Filters.Add "'Some File Description' Excel Files", "*.xls, *.xlsx, *.xlsm"
Set fle = Application.FileDialog(3)
With fle
.Title = "Select a file"
.AllowMultiSelect = False
If startFolder = -1 Then
.InitialFileName = CurrentProject.Path
Else
If Right(startFolder, 1) <> "\" Then
.InitialFileName = startFolder & "\"
Else
.InitialFileName = startFolder
End If
End If
If .Show <> -1 Then GoTo NextCode
vItem = .SelectedItems(1)
End With
NextCode:
GetFile = vItem
Set fle = Nothing
End Function
I have managed to solve my problem. There is nothing wrong with code in my question, except that instead of declaring
Dim ExcelApp As Excel.Application
It's better to use
Dim ExcelApp As Object
But much bigger problem is with code that does changes in Excel, such as this line:
x = Range(Cells(1, i), Cells(Rows.Count, i).End(xlUp)).Value
And correct synthax is:
x = ExcelApp.Range(ExcelApp.Cells(1, i), ExcelApp.Cells(ExcelApp.Rows.Count, i).End(xlUp)).Value 'maybe also better to replace xlUp with -4162
So, whenever you use some code for Excel file from Access, DON'T FORGET to reference everything to Excel object. And ofcourse, before everything, a proper reference must be set in VBA console, in my case Microsoft Office 15.0 library.
I am trying to write a code to open an Excel file and then search through it. Even though, I am having problems just retrieving the number of worksheets in the workbook. I get the error:
424 - VBScript Runtime Error, Object Required
Any thoughts? Here is the small portion of the code I am having problems with:
Dim Shell : Set Shell = WScript.CreateObject( "WScript.Shell" )
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim objExcel : Set objExcel = CreateObject("Excel.Application")
Dim myworkbook, worksheetcount
Set myworkbook = objExcel.Workbooks.Open("C:\Temp\Test.xlsx")
On Error Resume Next
Set worksheetcount = myworkbook.worksheets.count 'fails
If Err.number <> 0 Then
ShowError()
myworkbook.Close False
End if
Sub ShowError()
WScript.Echo Err.Number & " Srce: " & Err.Source & " Desc: " & Err.Description
Err.Clear
End Sub
The following would do the job.
VBA version
Dim Shell As Object: Set Shell = CreateObject("WScript.Shell")
Dim oFSO As Object: Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim objExcel As Application: Set objExcel = CreateObject("Excel.Application")
Dim myworkbook As Workbook, worksheetcount As Long
Set myworkbook = objExcel.Workbooks.Open("C:\Temp\Test.xlsx")
On Error Resume Next
worksheetcount = myworkbook.Worksheets.Count
If Err.Number <> 0 Then
ShowError
myworkbook.Close False
End If
VBScript version
Dim Shell: Set Shell = WScript.CreateObject("WScript.Shell")
Dim oFSO: Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim objExcel: Set objExcel = CreateObject("Excel.Application")
Dim myworkbook, worksheetcount
Set myworkbook = objExcel.Workbooks.Open("C:\Temp\Test.xlsx")
On Error Resume Next
worksheetcount = myworkbook.Worksheets.Count
If Err.Number <> 0 Then
ShowError
myworkbook.Close False
End If
You had error, because you tried to Set a value to worksheetcount which is not an object. You use Set only to objects.