what is wrong with the following code?, Every time I run it I get a "Run-Time Error 91, Object variable or with black variable not set"
Private Sub Document_Open()
Dim workBook As workBook
Application.ScreenUpdating = True
Set workBook = Workbooks.Open("Z:\Credit_Check_DB.xls", True, True)
txtCompany1.Value = workBook.Worksheets("Sheet2").Range("A1").Formula
txtCompany2.Value = workBook.Worksheets("Sheet2").Range("A1").Formula
txtCityState1.Value = workBook.Worksheets("Sheet2").Range("C1").Formula
txtCityState2.Value = workBook.Worksheets("Sheet2").Range("C1").Formula
txtDate1.Value = workBook.Worksheets("Sheet2").Range("F1").Value
txtAddress1.Value = workBook.Worksheets("Sheet2").Range("B1").Formula
txtZip1.Value = workBook.Worksheets("Sheet2").Range("D1").Formula
txtPO.Value = "Purchase Order#: " & workBook.Worksheets("Sheet2").Range("I1").Formula
txtRec.Value = workBook.Worksheets("Sheet2").Range("K1").Formula
workBook.Close False
Set workBook = Nothing
Application.ScreenUpdating = True
Close_Excel
End Sub
Private Sub Close_Excel() 'closes excel application.
Dim Excel As Excel.Application
Dim ExcelOpened As Boolean
ExcelOpened = False
On Error Resume Next
Set Excel = GetObject(, "Excel.Application")
If Excel Is Nothing Then
Set Excel = New Excel.Application
ExcelOpened = True
End If
On Error GoTo 0
With Excel
If ExcelOpened Then
.Visible = True
.Workbooks.Add
End If
.ActiveWorkbook.Close False ***<-***!!!!!Debugger points to here!!!!!******
.Quit
End With
End Sub
any idea what is wrong with my code? I am basically pulling information from Excel into word.
Maybe Excel does not point to any Excel application (something went wrong, but you skipped the error), so ActiveWorkbook points to nothing. You should put On Error GoTo 0 immediately after GetObject.
Related
I am getting inconsistent results when I try to refer to an active workbook. About half the time I get the "Method of 'Sheets' of Object '_Global' not failed" error and other times the code works fine. I don't see a pattern.
The VBA code is part of a Word document that allows the user to open a template Excel file and select/copy text from the Word doc into rows on the Excel file.
In a previous sub I successfully open an Excel template file (I call it a RTM template). In the code below I want to activate the "RTM" worksheet, select the first cell where the template could already have data in it from a previous execution and if there is, then count how many rows of data exist. In this way the new data will be posted in the first row which does not have any data. I am using named ranges in my Workbook to refer to the starting cell ("First_Cell_For_Data").
When I run my code sometimes it runs without error and other times it stops on the "Sheets("RTM").Activate" and gives me the "Method...." error. The same result occurs when I change the variable definition of wb_open to Object. I have also tried using "wb_open.Sheets("RTM").Activate" with the same results.
As suggested in the comments below I added "If wb_open is nothing ...." to debug the issue. I also added the sub List_Open_Workbooks which enumerates the open workbooks (of which there is only 1) and activates the one that matches the name of the one with the correct filename. This is successful. But upon returning to Check_Excel_RTM_Template I still get the Method error on the "Sheets("RTM").Activate" line.
Second Update: after more time diagnosing the problem (which still occurs intermittently) I have added some code that may help getting to the root of the problem. In the "List_Open_Workbooks" sub I test for xlApp.Workbooks.Count = 0. So all references to an open Excel workbook will fail. At this point my template workbook is open in Windows. Am I drawing the correct conclusion?
Third Update: I tried Set wb_open = GetObject(str_filename) where str_filename contains the name of the Excel template file I just opened.
I get the following error message.
Also, I noticed that if I start with a fresh launch of Word and Excel it seems to run just fine.
Sub Check_Excel_RTM_Template(b_Excel_File_Has_Data As Boolean, i_rows_of_data As Integer)
Dim i_starting_row_for_data As Integer
Dim wb_open As Object
Set wb_open = ActiveWorkbook
i_rows_of_data = 0
If wb_open Is Nothing Then
MsgBox "RTM Workbook not open in Check_Excel_RTM_Template"
Call List_Open_Workbooks(b_Excel_File_Has_Data, i_rows_of_data)
Else
' On Error GoTo Err1:
' Sheets("RTM").Activate
' range("First_Cell_For_Data").Select
Workbooks(wb_open.Name).Worksheets("RTM").range("First_Cell_For_Data").Select
If Trim(ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(ActiveCell.Value) = ""
ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
End If
Exit Sub
Err1:
MsgBox getName(str_Excel_Filename) & " is not a RTM template file."
b_abort = True
End Sub
Sub to enumerate all open workbooks
Sub List_Open_Workbooks(b_Excel_File_Has_Data As Boolean, i_rows_of_data As Integer)
Dim xlApp As Excel.Application
Set xlApp = GetObject(, "Excel.Application")
Dim str_filename As String
Dim xlWB As Excel.Workbook
If xlApp.Workbooks.Count = 0 Then
MsgBox "Error: Windows thinks there are no workbooks open in List_Open_Workbooks"
b_abort = True
Exit Sub
End If
For Each xlWB In xlApp.Workbooks
Debug.Print xlWB.Name
str_filename = getName(str_Excel_Filename)
If Trim(xlWB.Name) = Trim(str_filename) Then
xlWB.Activate
If xlWB Is Nothing Then
MsgBox "Workbook still not active in List_Open_Workbooks"
b_abort = True
Exit Sub
Else
' Sheets("RTM").Activate
Workbooks(xlWB.Name).Worksheets("RTM").range("First_Cell_For_Data").Select
range("First_Cell_For_Data").Select
If Trim(ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(ActiveCell.Value) = ""
ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
End If
End If
Next xlWB
Set xlApp = Nothing
Set xlWB = Nothing
End Sub
Function to extract filename from path/filename
Function getName(pf)
getName = Split(Mid(pf, InStrRev(pf, "\") + 1), ".")(0) & ".xlsx"
End Function
I am hoping I found the source of my problem and solved it.
I believe that referring to an open workbook in sub using Dim wb_open As Object & Set wb_open = ActiveWorkbook in the Check_Excel_RTM_Template sub is causing my inconsistent problems....perhaps this is an anomoly (bug) in the VBA implementation in Word.
In the revised code I posted below I am passing the o_Excel object from the calling routine and using oExcel.Activesheet.xxx to reference ranges and values.
Now I next problem is that I am having errors on the form control button code which also uses the Dim wb_open As Object & Set wb_open = ActiveWorkbook approach to referring to the open workbook. But I'll post that as a new question.
Thanks to all who commented and provided suggestions.
Sub Check_Excel_RTM_Template(oExcel As Object)
Dim i_starting_row_for_data As Integer
Dim str_filename As String
i_rows_of_data = 0
On Error GoTo Err1:
oExcel.ActiveSheet.range("First_Cell_For_Data").Select
If Trim(oExcel.ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(oExcel.ActiveCell.Value) = ""
oExcel.ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
Exit Sub
Err1:
Documents(str_doc_index).Activate
MsgBox getName(str_Excel_Filename) & " is not a RTM template file."
b_abort = True
End Sub
I have an issue with a macro that is located in Outlook. The code is triggered by a "Private Sub" code that creates a "TriggerExcel(1)" or "TriggerExcel(2)" which depends of the mail subject.
When the code is triggered it sometimes got stuck at line: Set ExApp = Excel.Application 'Codes
Where I get the following Error:
My guess is that the code doesn't define the excel object correctly in the code, but I have a hard time to understand how this should be made... Any advice or suggestions are much appreciated.
Public Sub TriggerExcel(Mode As Integer)
‘Activate following tool reference: Tool-References-Microsoft Excel 14.0 Object library -biblioteket
Dim ExApp As Excel.Application
Dim ExWbk As Workbook
Set ExApp = Excel.Application 'Codes
cause error here
ExApp.DisplayAlerts = False
If Mode = 1 Then
On Error Resume Next
Set ExWbk = Workbooks("Nyins.xlsm")
Debug.Print ExWbk.Name
On Error GoTo 0
'Set ExWbk = ExApp.Workbooks.Open("C:\Users\linsten\Desktop\Nyins.xlsm")
ExApp.Visible = False
'ExWbk.Application.Run "mymain.main"
If ExWbk Is Nothing Then
Set ExWbk = ExApp.Workbooks.Open("\\Sca9a\pd-61$\Control\Process\Nyins.xlsm")
End If
ExWbk.Application.Run "MainModule.main"
ElseIf Mode = 2 Then
Set ExApp = Excel.Application
On Error Resume Next
Set ExWbk = Workbooks("Val.xlsm")
Debug.Print ExWbk.Name
On Error GoTo 0
ExApp.Visible = False
If ExWbk Is Nothing Then
Set ExWbk = ExApp.Workbooks.Open("\\Sca9a\pd-61$\Control\Process\Daily\Val.xlsm")
End If
ExWbk.Application.Run "MyMain.Main"
End If
ExWbk.Close
ExApp.Quit
End Sub
I have an Outlook Macro that saves attachments based on a search of an e-mail inbox. The Aggregation File is then opened, then a loop opens the first of the saved attachments and copies the "AggregateThis" named range.
What I need to achieve is:
1). Activate the Aggregation File
2). Activate the Row where the result of the search for "END" is located
3). Insert the copied cells above end
The Outlook Object model is giving me trouble, this would be a total cinch in Excel VBA. Your help would mean so much!
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
.Workbooks.Open ("J:\Retail Finance\Varicent\General Teamshare Resources\Acting Mgr Assignment Bonus Aggregation.xlsx")
Dim x As Variant
i = -1
For Each x In AttachNames
Dim wb As Object
i = i + 1
Set wb = .Workbooks.Open("J:\Retail Finance\Varicent\General Teamshare Resources\Teamshare AAA\" & AttachNames(i))
Set wb = .Worksheets("Additional Assignment Bonus FRM")
'Copies the "Aggregate This" named range from the Individual File (i)
With wb.Range("AggregateThis")
.Copy
End With
'Switches focus to Aggregation File
Set wb = .Workbooks("J:\Retail Finance\Varicent\General Teamshare Resources\Acting Mgr Assignment Bonus Aggregation.xlsx")
With wb
.Activate '#1). I want to put focus on this file it throws an error
End With
'Find EndRow in the Aggregation File
Set wb = .Worksheets("Additional Assignment Bonus FRM").Cells.Find("End")
With wb
.ActivateRow '#2).This throws an error
.PasteSpecialInsertRows '#3). This doesnt work
End With
Next
The original code didn't work properly because, for .Activate to work, ScreenUpdating must be set to True (which it is by default).
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = True '## Was set to False in code originally##
.Workbooks.Open ("J:\Retail Finance\Varicent\General Teamshare Resources\Acting Mgr Assignment Bonus Aggregation.xlsx")
Dim x As Variant
i = -1
For Each x In AttachNames
Dim wb As Object
i = i + 1
Set wb = .Workbooks.Open("J:\Retail Finance\Varicent\General Teamshare Resources\Teamshare AAA\" & AttachNames(i))
With xlApp
.Worksheets("Additional Assignment Bonus FRM").Range("AggregateThis").Copy 'Copies Range
End With
Set wb = .Workbooks.Open("J:\Retail Finance\Varicent\General Teamshare Resources\Acting Mgr Assignment Bonus Aggregation.xlsx")
With wb
.Worksheets("Additional Assignment Bonus FRM").Rows.Find("End").Select
.Worksheets("Additional Assignment Bonus FRM").Activerange.Paste '##This needs to be fixed##, will edit response soon.
End With
Next
End With
End Sub
I have a small Excel-macro which opens a visio-file. With Excel 2010 everything worked fine. Now I've installed Office 2016 and tried the same excel-macro and it won't work.
There is no exception, but I see that my variable "VisioDoc" is empty.
Do you have any ideas where the Problem could be?
Sub cmdChooseFile_Click()
'...do something
Set VisioDoc = openDocument(filepath)
If VisioDoc Is Nothing Then
MsgBox "boom, didn't work!", vbExclamation
Exit Sub
End If
End Sub
Private Function openDocument(docPath As String) As Visio.Document
visioOpened = True
Application.StatusBar = "Lade Visiodokument..."
On Error Resume Next
Set VisioApp = GetObject(, "Visio.Application")
If VisioApp Is Nothing Then
Set VisioApp = CreateObject("Visio.Application")
VisioApp.Visible = False
visioOpened = False
End If
Set openDocument = VisioApp.Documents.Open(docPath)
Application.StatusBar = False
End Function
Private Sub Workbook_Open()
Dim SourceList(0) As Workbook
Dim PathList() As String
Dim n As Integer
PathList = Split("\data\WeaponInfo.csv", ",")
ThisWorkbook.Activate
Application.ActiveWindow.Visible = False
Application.ScreenUpdating = False
For n = 0 To Ubound(PathList)
Workbooks.Open Filename:=ThisWorkbook.Path & PathList(n)
Set SourceList(n) = ActiveWorkbook
ActiveWindow.Visible = False
Next
Application.ScreenUpdating = True
Workbooks.Open Filename:=ThisWorkbook.Path & "\HeroForge Anew 3.5 v7.4.0.1.xlsm", UpdateLinks:=3
ActiveWindow.Visible = True
Application.DisplayAlerts = False
For n = 0 To UBound(SourceList)
SourceList(n).Close
Next
Application.DisplayAlerts = True
End Sub
The line For n = 0 to PathList.GetUpperBound(0) is throwing a "Compile Error (invalid qualifier) whenever I try to run this macro. Specifically it highlights PathList as being the problem.
Also, if I cut out the loop and just have the contents run once (replacing the PathList(n) with "\data\WeaponInfo.csv"), it throws an "Object Variable or With block variable not set" error on the SourceList(0) = ActiveWorkbook line. What am I doing wrong?
I'm aware that the loop is currently pointless; it's futureproofing as I'm going to be using this macro to open multiple data references.
EDIT: Made changes suggested by #Jeremy below, now getting the "Object variable or With block variable not set" error on the SourceList(n).Close line.
EDIT2: Fixed the loop, again on the advice of #Jeremy, by changing Dim SourceList(1) As Workbook to Dim SourceList(0) As Workbook
A couple of issues:
In VBA, the GetUpperBound method does not exist, it is for .NET only. Change it to Ubound function.
You may run into a problem with Sourcelist(0) = ActiveWorkbook. Use the Set keyword when assigning object references.
Source is not defined in your loop. ALWAYS put Option Explicit at the top of your code module to force you to declare your variables. It will save pain in the future.
What are you trying to do with splitting that string? you will just get one value, which is the string you are passing in.
Private Sub Workbook_Open()
Dim SourceList(1) As Workbook
Dim PathList() As String
Dim n as Integer
PathList = Split("\data\WeaponInfo.csv", ",")
ThisWorkbook.Activate
Application.ActiveWindow.Visible = False
Application.ScreenUpdating = False
For n = 0 To Ubound(PathList)
Workbooks.Open Filename:=ThisWorkbook.Path & PathList(n)
Set SourceList(0) = ActiveWorkbook
Next
ActiveWindow.Visible = False
Application.ScreenUpdating = True
Workbooks.Open Filename:=ThisWorkbook.Path & "\HeroForge Anew 3.5 v7.4.0.1.xlsm", UpdateLinks:=3
ActiveWindow.Visible = True
For Each Source In SourceList
Source.Close
Next
End Sub