I'am creating an Access database where different clients should be stored later, currently they're stored in an Excel workbook.
I have access to the data of an SQL database (I can't change anything there) where the current Excel sheet gets client name and other informations from and I want that too in my Access database. The problem is that there is only an interface for Excel to connect to the database. It's an Excel AddIn with a macro and I don't have access to its code.
My solution was that i run the code in Access calling a macro in an Excel sheet and that calls the Addin macro. But it's not working...
It runs the Excel macro perfecly but when that tries to run the other Excel macro it fails. Sometimes (it's different when I change the Excel macro code) I get this error in the Access VBA editor:
Runtime error '-2147417851 (80010105)'
The method 'Run' for the object '_Application' is failed
Note: I have translated the text from german to english so it's probably not the exact error text.
And sometimes i get an error from Excel which mean the sheet which contains the AddIn macro could not be found but the addin is installed and when I debug trough the macro it works perfectly.
The AddIn is installed I have checked that with Application.Addins(5).Name in a for loop.
I have searched for 2 days now and I don't get further, I haven't even found someone with the same problem so far.
Here is my Access VBA code:
Public Sub getData(portfolioNumber As String)
Dim xlApp As Object
Dim sFile As String
Dim sClientName As String
Dim sOtherData As String
sFile = CurrentProject.Path & "\ImportSheet.xlsm"
Set xlApp = CreateObject("Excel.Application")
xlApp.Workbooks.Open sFile
xlApp.Cells(5, 6).Value = portfolioNumber
xlApp.Cells(6, 6).Value = portfolioNumber
xlApp.Run "importAMSData"
sClientName = xlApp.Cells(8, 8).Value
sOtherData = xlApp.Cells(8, 9).Value
xlApp.Workbooks.Close
MsgBox (sClientName & " " & sOtherData)
Set xlApp = Nothing
End Sub
And here is my Excel VBA code which should call the other macro:
Public Sub importAMSData()
Dim iLastRow As Double
Dim iLastCol As Double
Dim dErrNo As Double
Dim ws As Worksheet
Dim wb As Workbook
Dim aAddin As AddIn
Dim wbOpen As Boolean
Set ws = ThisWorkbook.Sheets(1)
ws.Activate
iLastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
iLastCol = ws.Cells(7, ws.Columns.Count).End(xlToLeft).Column
If iLastRow > 7 And iLastCol > 1 Then
ws.Range(ws.Cells(8, 1), ws.Cells(iLastRow, iLastCol)).ClearContents
End If
wbOpen = False
ws.Cells(1, 2).Select
The AddIn should be installed by default but after it haven't worked I tried to reinstall it
Set aAddin = Application.AddIns.Add("C:\Program Files\Microsoft Office\Office14\XLSTART\SPEZM.xlam")
aAddin.Installed = True
Application.Run "SPEZM.xls!import"
I have also tried:
aAddin.Application.Run "import"
Often (means always if the other error not occurs) here comes an error saying that Excel haven't found Sheetname.xls but the AddIn is installed I have checked that.
I thank you for you're help and sorry for the long question.
Related
I'm creating a spreadsheet to view a single product extracting values from a closed workbook (products.xlsx), using the SKU as a lookup value.
This code runs into:
Run-time error '1004': Method 'Range' of object '_Global' failed
I'm developing the spreadsheet to manage WooCommerce Products using Excel for our company's online store. Our need is to view a single product and be able to edit or delete it and also add more products even though the database is not within the current workbook.
Sub get_data_form_another_workbook()
Dim databook As Workbook
Dim test As String
Application.ScreenUpdating = False
' Open database in the background
Set databook = Workbooks.Open(ThisWorkbook.Path & "\products.xlsx")
' loop through database table to get required value
' AND THIS IS WHERE I'M GETTING AN ERROR
test = Application.WorksheetFuncion.VLookup(Range("product_current"), _
databook.Sheets("Sheet1").Range("A:F"), 4, 0)
' Test
Debug.Print test
databook.Close
Application.ScreenUpdating = True
End Sub
Thanks for all the responses... I edited the code a bit and it seems my mistake was on referencing the sheets properly... In the products.xlsb, the sheet I was trying to reference is "data"... Changed "Sheet1" to "data" and it worked...
Sub get_data_form_another_workbook()
Dim databook As Workbook
Dim test As Variant
Application.ScreenUpdating = False
' Open database in the background
Set databook = Workbooks.Open(ThisWorkbook.Path & "\products.xlsx")
' loop through database table to get required value
test = Application.VLookup(ThisWorkbook.Worksheets("product").Range("product_current"), _
databook.Sheets("Data").Range("A:F"), 4, 0)
' Test
Debug.Print test
databook.Close
Application.ScreenUpdating = True
End Sub
I'm having trouble debugging my vba code. The goal of the macro is to take a sheet in the current workbook and save that as a specific csv file. This code worked fine until I got a new computer with Catalina (10.15.4). The error occurs at pasteRange.Value = copyRange.Value and the error code is VBA: Method 'Value' of object 'Range' failed (Run-time error '1004'). So when it errors, MasterLoad.csv is open, but the source data just can't copy over.
Sub SheetToCSV()
Application.ScreenUpdating = False: Application.EnableEvents = False: Application.DisplayAlerts = False
' On Error GoTo Cleanup
Dim strSourceSheet As String
Dim strFullname As String
Dim fileAccessGranted As Boolean
Dim filePermissionCandidates
Dim copyWB As Workbook
Dim pasteWB As Workbook
Dim copyRange As Range
Dim pasteRange As Range
Set copyWB = ThisWorkbook
' set variables for sheet name and file path
strSourceSheet = "MasterLoad"
strFullname = "/Users/mypath/MasterLoad.csv"
' grant permission for VBA to open/save MasterLoad file
filePermissionCandidates = Array(strFullname)
grantFileAccess (filePermissionCandidates)
' set copy range
Set copyRange = copyWB.Sheets(strSourceSheet).Range("A1:ZZ2000")
' open paste WB, set paste range, set values, and save
Set pasteWB = Workbooks.Open(strFullname)
Set pasteRange = pasteWB.Sheets(1).Range("A1:ZZ2000")
pasteRange.Value = copyRange.Value
pasteWB.SaveAs FileName:=strFullname, _
FileFormat:=xlCSV
pasteWB.Close SaveChanges:=True 'close wb and save
Application.ScreenUpdating = True: Application.EnableEvents = True: Application.DisplayAlerts = True
End Sub
Function grantFileAccess(filePermissionCandidates)
grantFileAccess = GrantAccessToMultipleFiles(filePermissionCandidates) 'returns true if access granted, false otherwise_
End Function
I'm not sure if it's actually an OS issue, because I have virtually the same code in a different workbook and it worked fine with the new computer, but nothing has else changed but getting a new computer with this macro. Any thoughts?
Just to be sure, put a breakpoint on the line
pasteRange.Value = copyRange.Value
and check that both the ranges are well defined.
I had a similar issue when copying and inserting an entire column, sometimes it failed with VBA: Method 'Insert' of object 'Range' failed (Run-time error '1004') for no apparent reason and Excel broke completely and had to be restarted. I'm pretty sure it is a bug in Excel.
As suggested by #ComputerVersteher I removed Application.DisplaysAlerts = False and got an error message saying I didn't have enough memory to complete the operation. I changed the copy/paste range to A1:JZ2000 and it worked, but I still don't understand why the range A1:ZZ2000 wouldn't work on my newer/better computer.
I have adapted code that checks the subject line of new Outlook emails for a keyword, opens a workbook and pastes certain information into this workbook:
Option Explicit
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
If InStr(Msg.Subject, "Re:") > 0 Then
Exit Sub
ElseIf InStr(Msg.Subject, "MDI Board") > 0 Then '// Keyword goes here
'// Declare all variables needed for excel functionality and open appropriate document
Dim oXL As Object
Dim oWS As Object
Dim lngRow As Long
Set oXL = CreateObject("Excel.Application")
oXL.Workbooks.Open FileName:="T:\Capstone Proj\TimeStampsOnly.xlsx", AddTOMRU:=False, UpdateLinks:=False
'// Change sheet name to suit
Set oWS = oXL.Sheets("TimeStamps")
lngRow = oWS.Range("A" & oXL.Rows.Count).End(-4162).Offset(1).Row '// -4162 = xlUp. not available late bound
With oWS
.cells(lngRow, 1).Value = Msg.SenderName
.cells(lngRow, 2).Value = Msg.ReceivedTime
.cells(lngRow, 3).Value = Msg.ReceivedByName
.cells(lngRow, 4).Value = Msg.Subject
.cells(lngRow, 5).Value = Msg.Body
'// And others as needed - you will have Intellisense
End With
With oXL
.activeworkbook.Save
.activeworkbook.Close SaveChanges:=2 '// 2 = xlDoNotSaveChanges but not availabe late bound
.Application.Quit
End With
Set oXL = Nothing
Set oWS = Nothing
End If
Else
Exit Sub
End If
ExitPoint:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ExitPoint
'// Debug only
Resume
End Sub
I was having issues with being able to access the workbook after the Outlook VBA code ran. It would give multiple errors such as 'the workbook is already open' even though I had no instance of Excel running on my machine or 'this file is read-only' etc.
I tried to circumvent this issue by using another workbook with an update macro that would update a dashboard using the information in the problematic workbook however I am getting a 'subscript out of range' error when I try to set a variable to the workbook with the Outlook data.
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set wkb = Excel.Workbooks("T:\Capstone Proj\TimeStampsOnly.xlsx")
Set wks = wkb.Worksheets("Timestamps")
Wagner Braga!
I have had a similar problem in the past. In my case, I was not looking for subjects containing certain characters but rather subjects equal to a string. Either way, that is irrelevant to your issue.
I found that, like yours, my code errored when trying to put info from the email into Excel. I did read the comments on your question and know that you don't want to use unneccessary computing power. My method is not the most efficient way to accomplish what you want to do, but it was the only way I could do it.
First of all, I did not edit the Excel workbook from the Outlook VBA. I tried to do it, but this is where my code errored. Instead, I set the email object as a variable's value (to make it easier to reference). Then I read the information from the email I wanted into an array by using the Split(...) function. The code created a text file and wrote the data to it so that it would be accessible by Excel. Before writing the data from the email, I also wrote the text "!NEWDATA!" on the first line. You could use any string you want, as long as there is a unique identifier at the top so that Excel recognizes that it should get data from the file. I then opened the workbook, just like I would open any other file using VBA.
Now, the Excel workboook requires some VBA code as well for my method to work. In the Workbook_Open() VBA sub in the workbook code, Excel should read the first line or first x number of characters. You can use either method, but this is should point to the part of the file that has your "!NEWDATA!" or other string. If this string is the one you wrote from Outlook, continue reading the file. If it's not, Exit Sub. From here you can have Excel read the rest of the file (which you separated by a delimeter of your choice via Outlook VBA) and put the data into the corresponding cells. Then change the "!NEWDATA!" and the rest of the file so that if you start Excel manually (and you don't want to import any data) the Workbook_Open() sub will stop and not error. You can change it to anything like a blank file, "No new data", or any other string you like. After this, use VBA to save the workbook and close it.
As you probably know, you could set the Excel window's Visible property to False if you don't want the user seeing the workbook.
If you have any questions or comments, let me know. I'll be happy to answer any questions you may have.
This code copies columns P & Q from each worksheet and posts them to a new worksheet consolidated. It also deletes all blank cells.
The code works on a very small file but isn't producing the same results on the new workbook.
ALL COLUMNS from previous "small workbook" to new workbook are the same. The only thing that changed is the number of worksheets which is 650.
I get a runtime error 429 "Activex component can't create object".
Sub merge()
Dim Sh As Worksheet, ShM As Worksheet, i&, z&
Application.ScreenUpdating = 0
Set Sh = Worksheets.Add(, Sheets(Sheets.Count))
Sh.Name = "consolidated"
For Each ShM In ThisWorkbook.Worksheets
If ShM.Name <> Sh.Name Then
i = ShM.Cells(Rows.Count, 17).End(xlUp).Row
z = Sh.Cells(Rows.Count, 2).End(xlUp).Row + 1
While (z > 1) And (Sh.Cells(z, 2).Value = "")
z = z - 1
Wend
ShM.Activate: ShM.Range(Cells(1, 16), Cells(i, 17)).Copy
Sh.Activate: Sh.Cells(z, 1).PasteSpecial xlPasteValues
End If
Next ShM
Application.ScreenUpdating = 1
End Sub
This error is not caused by the code you've posted, please see this:
You receive run-time error 429 when you automate Office applications
also this issue has been discussed here:
Run-time error '429': ActiveX component can't create object VBA
check tools~>references for the missing components
I got the same issue 4 years later, my VBA code literally failed on the very first two lines:
Dim wb As Workbook
Set wb = ThisWorkbook
Same error if I use ?ThisWorkbook.name in the immediate window, etc. No matter what I do, I cannot use the "ThisWorkbook" object in this particular .xlsm
I created a brand new workbook, saved it as .xslm and copied the entire module to the new book, bingo, works perfectly.
There doesn't seem to be any difference between the new book I created and the old book that doesn't work...
tools->references are identical, they were saved on the same machine, same version of excel, etc etc.
It's just a bizzare issue that I can't figure out the cause of, in this particular Workbook, the "ThisWorkbook" function is broken. Re-creating the workbook from scratch seems to resolve it, but it's a poor solution.
I have a batch of Word documents that have embedded Excel worksheets. Users have been entering data in the Excel sheet by double clicking the image of the sheet and opening an embedded Excel object. I need to get to the user entered data.
Below is WORD VBA with a reference to the Microsoft Excel 15 library. (The Word and Excel object where created under Office 2010.)
I can find the OLE object but I can't do anything with it. In the code below I tried to assign the object to a Worksheet object but I get a type mismatch error.
To complicate things further the embedded Excel sheet has macros. During some passes at the problem an Excel window opens with a prompt to enable macros security prompt. I can most likely temporarily disable macro checking to get past this.
All I need to do is get at the data in the worksheet to copy it elsewhere one time. I would be happy with just copying the worksheet to an external file if that is even possible.
I have Office 2010 and 2013, and Visual Studio 2010 Pro and 2014 Express at hand.
How can I get to the embedded worksheet data?
Sub x()
Dim oWS As Excel.Worksheet
Dim oIShape As InlineShape
For Each oIShape In ActiveDocument.InlineShapes
If Not oIShape.OLEFormat Is Nothing Then
If InStr(1, oIShape.OLEFormat.ProgID, "Excel") Then
oIShape.OLEFormat.ActivateAs (oIShape.OLEFormat.ClassType) 'Excel.Sheet.8
Set oWS = oIShape '** type mismatch
Debug.Print oWS.Cells(1, 1)
End If
End If
Next oIShape
End Sub
I used the suggested to get started on a previous try:
Modify embedded Excel workbook in Word document via VBA
Had some problems with proper references and the code bungling up the document.
Below is another pass that works OK but has some issues and code I don't understand.
1) I don't want to use Edit mode but other modes didn't work
2) The immaculate reference Set xlApp = GetObject(, "Excel.Application") is strange. Some kind of undocumented feature?
Sub TestMacro2()
Dim lNumShapes As Long
Dim lShapeCnt As Long
Dim xlApp As Object
Dim wrdActDoc As Document
Dim iRow As Integer
Dim iCol As Integer
Set wrdActDoc = ActiveDocument
For lShapeCnt = 1 To wrdActDoc.InlineShapes.Count
If wrdActDoc.InlineShapes(lShapeCnt).Type = wdInlineShapeEmbeddedOLEObject Then
If wrdActDoc.InlineShapes(lShapeCnt).OLEFormat.ProgID = "Excel.Sheet.8" Then
wrdActDoc.InlineShapes(lShapeCnt).OLEFormat.Edit
Set xlApp = GetObject(, "Excel.Application")
With xlApp.Workbooks(1).Worksheets(2) ' can be multiple sheets, #2 is needed in this case
For iCol = 3 To .UsedRange.Columns.Count
If .Cells(1, iCol) = "" Then Exit For
For iRow = 1 To .UsedRange.Rows.Count
Debug.Print .Cells(iRow, iCol) & "; ";
Next iRow
Debug.Print 'line feed
Next iCol
End With
xlApp.Workbooks(1).Close
xlApp.Quit
Set xlApp = Nothing
End If
End If
Next lShapeCnt
End Sub
Code works well enough to accomplish my extraction task - thanks!