I am writing a vba sub in outlook that will: grab a unique value from the mail, look for that value in the column of an excel file, and return an associated value. I am working with an the .find function from the excel library to lookup my unique value in the excel, however, find is supposed to return a range of the first occurrence of my value but I cannot assign that value to the variable: pointer. I cannot reference it. Any insights appreciated. thank you!
Sub OTM1S() '(ByVal Item As Object)
Dim xlApp As Object
Dim wb As Workbook
Dim pointer As Range
Set xlApp = CreateObject("Excel.Application")
Set wb = xlApp.Workbooks.Open("I:\referencefile.xlsx")
'On Error Resume Next
pointer = wb.Sheets("Bonds").Range("A1:A10000").Find("XS1058142081")
MsgBox pointer.Offset(0, 1)
'On Error GoTo 0
wb.Save
wb.Close
End Sub
Where you are trying to set an object reference you need the Set keyword. Try this:
Sub OTM1S() '(ByVal Item As Object)
Dim xlApp As Object
Dim wb As Workbook
Dim pointer As Range
Set xlApp = CreateObject("Excel.Application")
Set wb = xlApp.Workbooks.Open("I:\referencefile.xlsx")
'On Error Resume Next
Set pointer = wb.Sheets("Bonds").Range("A1:A10000").Find("XS1058142081")
MsgBox pointer.Offset(0, 1)
'On Error GoTo 0
wb.Save
wb.Close
End Sub
You should also handle the scenario where the reference is not found. This can be done like so:
Set pointer = wb.Sheets("Bonds").Range("A1:A10000").Find("XS1058142081")
If Not pointer Is Nothing Then
MsgBox pointer.Offset(0,1)
Else
MsgBox "Sorry, couldn't find that in the specified range."
End If
Related
I have 2 workbooks that I run macros on "Air.xlsx" and "Ocean.xlsx", they are basically the same but for different purpose. I want to check if one of them is open , and set one of them as Wsht . I can't set them as set Wsht = activesheet because the macro starts from a different sheet.
Set Wsht = Workbooks("Air").ActiveSheet
Set Wsht = Workbooks("Ocean").ActiveSheet
an error would occur on this because i would only have one of them open.
I was suggested using below method, but i don't think it's an efficient way to do it
For Each wb In Workbooks
If wb.Name = "Air.xlsx" Then
Set PASsht = Workbooks("Air").ActiveSheet
End If
Next
Is there a way to check if Air or Ocean sheet is open and set one as Wsht?
Thanks
You can specify a sheet on whichever workbook is open. Try the code below.
Sub Test()
Dim wrksht As Worksheet
If WorkbookIsOpen("Air.xslx") Then
Set wrksht = Workbooks("Air.xlsx").Worksheets("Sheet1")
ElseIf WorkbookIsOpen("Ocean.xlsx") Then
Set wrksht = Workbooks("Ocean.xlsx").Worksheets("Sheet1")
Else
'Neither book is open, throw an error or something.
End If
End Sub
Public Function WorkbookIsOpen(FileName As String) As Boolean
Dim TestBk As Workbook
'Trying to set a reference to a closed workbook will
'throw an error - Err.Number = 0 will return TRUE or FALSE.
On Error Resume Next
Set TestBk = Workbooks(FileName)
WorkbookIsOpen = (Err.Number = 0)
On Error GoTo 0
End Function
A nice user has supplied me with a better solution to my already existing code but does not work within Word. I'm trying to open an excel document when a user clicks a button. There are multiple buttons that open the same document but I want it to change the worksheet if the document is already opened and not another instance of the document. The following gives me the error:
User-defined type not defined
Option Explicit
Public objExcel As Object
Sub Main()
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
On Error GoTo 0
If objExcel Is Nothing Then
Set objExcel = CreateObject("Excel.Application")
End If
End Sub
'==================================================================
Public Sub QE1_Click()
Dim wb As Workbook
Dim sht As Worksheet
If objExcel Is Nothing Then
Main
End If
objExcel.Visible = True
Set wb = objExcel.Workbooks.Open("H:\My Documents\Flowchart to Word\Quality and Environmental management system flowchart.xlsm")
On Error Resume Next
Set sht = wb.Worksheets("Project enquiry")
On Error GoTo 0
If sht Is Nothing Then
MsgBox "Workbook doesn't have a sheet named 'Project enquiry'", vbCritical, "Sheet critical error"
Else
sht.Activate
End If
End Sub
Unsure on why this does not work
In general, Workbook and Worksheet are unknown objects for Word. Thus, you have to define them with Excel. like this:
Dim wb As Excel.Workbook
Dim sht As Excel.Worksheet
In general, wb As Workbook works pretty well, when the VBA code is in Excel, because then Excel is the default environment. But in Word, you have to specify it explicitly. Make sure that you add Microsoft Excel 1N.0 Object Library from VBEditor> Extras> Libraries:
If you want to make it a bit easier, define wb and sht as Object. This is called "late binding" and is a bit slower.
I have a macro that runs fine on my computer, but when I put this macro on another computer it does not even allow to run in debug mode. It just crashes the MS Project saying that it stopped working.
Edit:
The crash comes from the following Set. I have already tried early binding as well Dim xlApp as Excel.Application but crashes anyway.
Dim xlApp As Object
Set xlApp = New Excel.Application
is there another way to set the xlApp as an Excel object?
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
Try late binding the Excel object and remove the reference.
I'd suggest using Late Binding. As #Josh said - you'll need to remove your library references and update a substantial portion of your code.
Any constants that are specific to Excel will need updating to their numerical equivalent.
For example, when using PasteSpecial you'd use something like xlPasteValues.
Open the immediate window in Excel and enter ?xlPasteValues. This will return -4163 which is the number you must enter into your code in place of xlPasteValues.
Sub Test()
Dim oXL As Object
Dim oWrkBk As Object
Dim oWrkSht As Object
Set oXL = CreateXL
Set oWrkBk = oXL.Workbooks.Open("C:\Workbook1.xlsx")
Set oWrkSht = oWrkBk.worksheets("Sheet1")
With oWrkSht
.Range("A1").Copy
.Range("B1").PasteSpecial -4163 'xlPasteValues
End With
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
please try this, just to see if it also crashes.
it creates the word object, then excel object and exits. each time it creates the object, it dispays the object name.
i am assuming that you also have msword installed
note: if you ever copy code from a web page, make sure that the quotation marks are correct. there appear to be several versions of quotation marks (opening quotes, closing quotes), and these are not valid in VBA
Sub test()
Dim myApp As Object
Set myApp = CreateObject("Word.Application")
MsgBox myApp.Name
Set myApp = CreateObject("Excel.Application")
MsgBox myApp.Name
Set myApp = Nothing
End Sub
i have written the following code which uses a global errorhandler that rectifies the error and resumes code again. right now i have labelled the lines and using 'Erl', i am checking which line caused the error and then accordingly finding the object and creating it.
What i want to do is to pass the object that caused the error to the errorhandler itself and then create that object and return control back to main procedure to resume from where it left off.
How to return the object that caused the error to an error handler? this way it would be more appropriate to handle some errors, instead of just returning an error message and error description.
as an example, i am letting the errorhandler handle creation of sheets if they are non-existent.
Option Explicit
'Worksheets: Public to VBproject as it may be used in almost every module.
Public WSCombined As Worksheet
Public WSResult As Worksheet
'Worksheet names: VBPublic to project as it may be used in almost every module.
Public Const Combined As String = "Combined data"
Public Const Result As String = "Result"
'Array: Public to VBproject as it may be used in almost every module.
Public Arr() As Variant
Sub Main()
On Error GoTo ERRHANDLER
Dim Rng As Range
With ThisWorkbook
'error labels for passing to Erl, so that corresponding sheet names can then be selected for sheet objects.
10001: Set WSCombined = .Sheets(Combined)
10002: Set WSResult = .Sheets(Result)
10003: Set Rng = WSCombined.Rows(1).EntireRow
10004: Arr = Rng
End With
EXITSUB:
' cleanup
Set WSCombined = Nothing
Set WSResult = Nothing
Exit Sub
ERRHANDLER:
If ErrorHandling(Err, ThisWorkbook, Erl) Then
GoTo EXITSUB
Else
Resume
End If
End Sub
Function ErrorHandling(objError As Object, Optional WB As Workbook, Optional ERlCode As Long) As Boolean
With objError
Select Case .Number
Case Is = 9 'subscript out of range
Select Case ERlCode
Case Is = 10001 ' Worksheet: for Combined sheet
Call SheetExists(WB, Combined)
Case Is = 10002 ' Worksheet: for Result sheet
Call SheetExists(WB, Result)
Case Is = 10003 ' Array: Array not initialized
Call IsArrayAllocated(Arr)
Case Else
End Select
ErrorHandling = False ' resume again at same line, after sheet has been created.
Case Is = 91 ' Object variable or with variable not found
Call IsArrayAllocated(Arr)
Case Is = ""
Case Else
MsgBox objError.Number & " - " & objError.Description
ErrorHandling = True
End Select
End With
objError.Clear
On Error GoTo 0
End Function
Function SheetExists(WBook As Workbook, SHTName As String) As Worksheet
On Error GoTo ERRHANDLE
With WBook
Set SheetExists = .Sheets(SHTName)
End With
EXITFUNC:
Exit Function
ERRHANDLE:
With WBook
Dim Sh As Worksheet
Set SheetExists = .Sheets.Add
SheetExists.Name = SHTName
End With
Resume EXITFUNC
End Function
Function IsArrayAllocated(Arr As Variant) As Variant
'Courtesy: #Chip Pearson
' check if array is initialized, if not initialize it
On Error GoTo ERRHANDLE
IsArrayAllocated = (IsArray(Arr) And Not IsError(LBound(Arr, 1)) And LBound(Arr, 1) <= UBound(Arr, 1))
EXITFUNC:
Exit Function
ERRHANDLE:
ReDim Arr(0 To 0)
IsArrayAllocated = Arr
GoTo EXITFUNC
End Function
To tackle some errors, the other way i was thinking is to just have functions created which could have their own error handling code and rectify the error in place itself, instead of passing it to a global error handler of main proc.
e.g.
Sub Main()
On Error GoTo ERRHANDLER
Dim Rng As Range
With ThisWorkbook
set WSCombined = SheetExists(ThisWorkbook, Combined)
Set WSResult = SheetExists(ThisWorkbook, Result)
....
....
Function SheetExists(WBook As Workbook, SHTName As String) As Worksheet
On Error GoTo ERRHANDLE
With WBook
Set SheetExists = .Sheets(SHTName)
End With
EXITFUNC:
Exit Function
ERRHANDLE:
With WBook
Dim Sh As Worksheet
Set SheetExists = .Sheets.Add
SheetExists.Name = SHTName
End With
Resume EXITFUNC
End Function
Any help would be most appreciated.
One answer to your specific question is to use another global object to store the object that threw the error in:
Public LastErrorObject As Object
Sub Main()
With ThisWorkbook
Set LastErrorObject = ThisWorkbook
Set WSCombined = .Sheets(Combined)
End With
End Sub
However, this is incredibly cumbersome, because you need to keep track of it everywhere. Also, it still doesn't do much in the way of giving you the context for the error.
Your second idea is much better, and doesn't abuse the error handler as much because it both acknowleges that there may be an error and actively seeks to avoid errors instead of passively trying to deal with them. For example, instead of indexing into ActiveWorkbook.Worksheets() directly, you can do something like this to make sure you get a new sheet back:
Private Function GetOrCreateWorksheet(book As Workbook, name As String) As Worksheet
On Error GoTo ForceNew
Dim result As Worksheet
Set result = book.Worksheets(name)
ForceNew:
If Err.Number = 9 Then
Set result = book.Worksheets.Add()
result.name = name
ElseIf Err.Number <> 0 Then
Err.Raise Err.Number, Err.source, Err.Description
End If
Set GetOrCreateWorksheet = result
End Function
Note that the error handling is only checking for the one specific error that you'll get if the sheet doesn't exit (Subscript out of range).
BTW and off topic, your Select Case syntax is overly convoluted - you only need to specify the case and can leave out the Is = syntax. It is also much easier to read with another level of indentation:
Select Case ERlCode
Case 10001
'...
Case 10002
'...
Case Else
'...
End Select
I'm trying to copy the values from a named range in Excel to a bookmark in Word. I found this code on the web that does it in Excel VBA, but I'm getting an Error 13.
Set pappWord = CreateObject("Word.Application")
Set docWord = pappWord.Documents.Add(Path)
'Loop through names in the activeworkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
End If
Next xlName
'Activate word and display document
With pappWord
.Visible = True
.ActiveWindow.WindowState = 0
.Activate
End With
I know that the line that is causing the error is:
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
What am i doing wrong? Also, how & where would I code so that I can export the doc to PDF?
Thanks in advance.
Note: I've already selected the reference to the Microsoft Word (version number 14) Object model in Excel
so I use it to accomplish this task but taking an image from formatted Excel table.
Sub FromExcelToWord()
Dim rg As Range
For Each xlName In wb.Names
If docWord.Bookmarks.Exists(xlName.Name) Then
Set rg = Range(xlName.Value)
rg.Copy
docWord.ActiveWindow.Selection.Goto what:=-1, Name:=xlName.Name
docWord.ActiveWindow.Selection.PasteSpecial link:=False, DataType:=wdPasteEnhancedMetafile, Placement:= _
0, DisplayAsIcon:=False
End If
Next xlName
End Sub
Just curious... Why are you adding a document rather than opening the relevant doc which has the bookmarks? Try this code (I usually test the code before posting but I haven't tested this particular code. Just quickly wrote it)
Also I am using Late Binding so no reference to the Word Object Library is required.
Sub Sample()
Dim wb As Workbook
Dim pappWord As Object, docWord As Object
Dim FlName As String
Dim xlName As Name
FlName = "C:\MyDoc.Doc" '<~~ Name of the file which has bookmarks
'~~> Establish an Word application object
On Error Resume Next
Set pappWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set pappWord = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0
Set docWord = pappWord.Documents.Open(FlName)
Set wb = ActiveWorkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName).Value
End If
Next xlName
'Activate word and display document
With pappWord
.Visible = True
.ActiveWindow.WindowState = 0
.Activate
End With
End Sub
EDIT
Changed
Range(xlName.Value)
to
Range(xlName).Value
Now the above code is TRIED AND TESTED :)