I am having trouble with what seems to be something simple from what I have found so far. I am trying to link data from an excel workbook to a table on a word document through VBA. This is the code that I have found and changed slightly so far...
Sub GetData()
Dim strPath As String
Dim strFileName As String
Dim strFileExtension As String
Dim strFullName As String
strPath = "file path here"
strFileName = "file name here"
strFileExtension = "Extension here"
strFullName = strPath & strFileName & strFileExtension
Set objWorkbook = objExcel.Workbooks.Open(strFullName)
'Set the text of the cell from Excel to the cell in the specified table in
'Word (the second table in this instance)
ActiveDocument.Tables(1).Cell(2, 2).Range.Text = objWorkbook.Sheets("Sheet1") _
.Cells(2, 1)
'Close Excel bits
objWorkbook.Close
Set objWorkbook = Nothing
End Sub
The initial errors I had found were not having the excel object library checked off in References and simple syntax errors. After fixing those I am now getting a 'RunTime Error 91 Object Variable or With Block Variable not set'. This error occurs when I am attempting to set the objWorkbook variable. I have these public variable declared...
Public objExcel As Excel.Application
Public objWorkbook As Excel.Workbook
Public objWorksheet As Excel.Worksheet
Public objRange As Excel.Range
However, when I look up this error, all I find is that I need to declare these public variables. Not sure where to go from here. If anyone could push me in the right direction, that would be greatly appreciated. Also, thank you for all the help so far, this website is a life saver.
Try this:
Sub GetData()
Dim strPath As String
Dim strFileName As String
Dim strFileExtension As String
Dim strFullName As String
dim objExcel As Object, objWorkbook As Object
strPath = "file path here"
strFileName = "file name here"
strFileExtension = "Extension here"
strFullName = strPath & strFileName & strFileExtension
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(strFullName)
'Set the text of the cell from Excel to the cell in the specified table in
'Word (the second table in this instance)
ActiveDocument.Tables(1).Cell(2, 2).Range.Text = objWorkbook.Sheets("Sheet1").Cells(2, 1)
'Close Excel bits
objWorkbook.Close
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
End Sub
Btw you don't need to add references if you use the CreateObject function as used above.
You had a couple of issues:
Did not define (set) the objExcel application
Weren't closing (cleaning) after execution properly
Unnecessary Public declarations of Excel objects
Related
I have a Word document with template contents where I will use VBA code to replace a textbox in the Word document with my user name to generate a pdf report for each user.
In my Excel VBA code, where I open the Word document, I need the path of the Word document.
If I hard code the Word document path, everything works.
When I store the path in a cell and assign it to a variable, it causes an error 13 type mismatch.
I declared the variable coverLocation as Variant.
I checked that the path is correct.
When I declare the variable as String it gives the error
"Object Required"
at Set coverLocation.
My simplified code to show the error.
Sub Test()
'Create and assign variables
Dim wb As Workbook
Dim ws1 As Worksheet
Dim saveLocation2 As String
Dim userName As Variant
Dim coverLocation As Variant
Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("Sheet1")
Set userName = ws1.Range("B4")
Set coverLocation = ws1.Range("B2")
MsgBox coverLocation, vbOKOnly 'MsgBox showing correct path location
'Word variables
Dim wd As Word.Application
Dim doc As Word.Document
Set wd = New Word.Application
wd.Visible = True
saveLocation2 = wb.Path & Application.PathSeparator & userName & "cover.pdf"
'Word to PDF code
Set doc = wd.Documents.Open(coverLocation) ' "error 13 Type Mismatch" at this line
With doc.Shapes("Text Box Name").TextFrame.TextRange.Find
.Text = "<<name>>"
.Replacement.Text = userName
.Execute Replace:=wdReplaceAll
End With
doc.ExportAsFixedFormat OutputFileName:=saveLocation2, _
ExportFormat:=wdExportFormatPDF
Application.DisplayAlerts = False
doc.Close SaveChanges:=False
Application.DisplayAlerts = True
'Ending
wd.Quit
End Sub
I'm posting my comment as answer to make it more readable. The problem is, that in your code coverLocation is a Range object, not a string, and the same goes for userName.
The best way to fix this, is to replace this line:
Set coverLocation = ws1.Range("B2")`
with this:
coverLocation = ws1.Range("B2").Value
and additionally replace
Dim coverLocation As Variant
with
Dim coverLocation As String
Also, you should replace
Set userName = ws1.Range("B4")
with
userName = ws1.Range("B4").Value
In that case, replacing
Dim userName As Variant
with
Dim userName As String
is also advisable.
The final code could look like this:
Sub Test()
'Create and assign variables
Dim wb As Workbook
Dim ws1 As Worksheet
Dim saveLocation2 As String
Dim userName As String
Dim coverLocation As String
Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("Sheet1")
userName = ws1.Range("B4").Value
coverLocation = ws1.Range("B2").Value
MsgBox coverLocation, vbOKOnly 'MsgBox showing correct path location
'Word variables
Dim wd As Word.Application
Dim doc As Word.Document
Set wd = New Word.Application
wd.Visible = True
saveLocation2 = wb.Path & Application.PathSeparator & userName & "cover.pdf"
'Word to PDF code
Set doc = wd.Documents.Open(coverLocation) ' "error 13 Type Mismatch" at this line
With doc.Shapes("Text Box Name").TextFrame.TextRange.Find
.Text = "<<name>>"
.Replacement.Text = userName
.Execute Replace:=wdReplaceAll
End With
doc.ExportAsFixedFormat OutputFileName:=saveLocation2, _
ExportFormat:=wdExportFormatPDF
Application.DisplayAlerts = False
doc.Close SaveChanges:=False
Application.DisplayAlerts = True
'Ending
wd.Quit
End Sub
Below is my code for the copying process from one workbook to another.
I looked up a lot of similar issues but i could not get this working.
when I run this the two files open up and then i get a third one called book1 with all results. then i get an error "Copy method of Worksheet class failed".
What Im trying to do is copy the general report sheet from o.Book to xBook.
I want to leave the books open for now until this is correct but i will use Xbook later.
Can I get help with this please?
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim oExcel As Excel.ApplicationClass
Dim oBook As Excel.WorkbookClass
Dim oBooks As Excel.Workbooks
Dim xExcel As Excel.ApplicationClass
Dim xBook As Excel.WorkbookClass
Dim xBooks As Excel.Workbooks
Dim user As String
Dim opath As String
Dim opathS As String
Dim timeStamp As DateTime = DateTime.Now
Dim path2 As String
Label1.Text = "Working..."
'Get the current system user user and set path to file
user = Environment.UserName
opath = "C:\Users\" + user + "\Downloads\ADC Open.xls"
path2 = "C:\Users\" + user + "\Downloads\Personal.xlsm"
opathS = "C:\Users\" + user + "\Desktop\Report.xls"
'Create first object
oExcel = CreateObject("Excel.Application")
oExcel.DisplayAlerts = False
oExcel.Visible = True
oBooks = oExcel.Workbooks
'Create second object
xExcel = CreateObject("Excel.Application")
xExcel.DisplayAlerts = False
xExcel.Visible = True
xBooks = xExcel.Workbooks
'open first book
oBook = oBooks.Open(opath)
'open second book
xBook = xBooks.Open(path2)
oBook.Worksheets("general_report").Copy(After:=xBook.Worksheets("general_report"))
'Run the subroutine.
'xExcel.Run("Execute")
'xExcel.DisplayAlerts = False
'Delete sheet not needed any more
'xBook.Sheets("general_report").Delete
'xExcel.DisplayAlerts = False
'Save results to new file
xBook.SaveAs(opathS)
Label1.Text = "File saved at: " + opathS
'Close the workbook and quit Excel.
oBook.Close(False)
System.Runtime.InteropServices.Marshal.
ReleaseComObject(oBook)
oBook = Nothing
System.Runtime.InteropServices.Marshal.
ReleaseComObject(oBooks)
oBooks = Nothing
oExcel.Quit()
System.Runtime.InteropServices.Marshal.
ReleaseComObject(oExcel)
oExcel = Nothing
'Delete original file after finished with it
'System.IO.File.Delete(opath)
End Sub
Can't add a comment yet, but if VB is the same across all platforms, shouldn't you Set the variable after declaring it ?
Set MyObject = YourObject ' Assign object reference.
Set MyObject = Nothing ' Discontinue association.
After all the responses I started looking into these object settings and find code that help with the explainations, I refactored my previous version and this is what I came up with. It works like a charm now. Thanks everyone for the help and comments.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim xlApp As Excel.Application = New Excel.Application
Dim user As String
Dim sourcePath As String
Dim targetPath As String
Dim savePath As String
Label1.Text = "Working..."
user = Environment.UserName
sourcePath = "C:\Users\" + user + "\Desktop\Report\ADC Open (Dell GTIE JIRA).xls"
targetPath = "C:\Users\" + user + "\Desktop\Report\Personal1.xlsm"
savePath = "C:\Users\" + user + "\Desktop\Report\Report" & Format(Now(), "DD-MMM-YYYY") & ".xlsm"
Dim wbSourceBook As Excel.Workbook = xlApp.Workbooks.Open _
(sourcePath, ReadOnly:=False)
Dim wbTargetBook As Excel.Workbook = xlApp.Workbooks.Open _
(targetPath, ReadOnly:=False)
'Excel expects to receive an array of objects that
'represent the worksheets to be copied or moved.
Dim oSheetsList() As Object = {"general_report"}
wbSourceBook.Sheets(oSheetsList).Copy(Before:=wbTargetBook.Worksheets(1))
wbSourceBook.Close(True)
Hi How can I access a spreadsheet from AutoCad and take a value from there and use it on AutoCAd
Here is my code but it does not get the value , it's always empty. Don't know what's wrong
Sub move()
Dim EXCELApplication As Object
Dim ExcelWorksheet As Object
Set EXCELApplication = CreateObject("Excel.Application")
EXCELApplication.workbooks.Open AcadToExcel
EXCELApplication.Visible = True
Set ExcelWorksheet = EXCELApplication.ActiveWorkbook.Sheets("Sheet1")
modelsize = ExcelWorksheet.Cells(21, 3).Value
Size = modelsize
End Sub
I just tested this and it works just fine for me:
Public Sub GetFromExcel()
Dim sFile As String
sFile = "C:\Users\" & Environ$("Username") & "\Desktop\Test2.xlsx"
Dim EXCELApplication As Object
Dim ExcelWorksheet As Object
Dim sValue As String
Set EXCELApplication = CreateObject("Excel.Application")
EXCELApplication.workbooks.Add sFile
EXCELApplication.Visible = True
Set ExcelWorksheet = EXCELApplication.ActiveWorkbook.Sheets("Sheet1")
sValue = ExcelWorksheet.Range("A1").Value
MsgBox sValue
End Sub
If it doesnt work for you, then the problem is your filename.
Hundreds of xlsx files in a directory are imported into a MS Access 2010 Database.
I've to clean the worksheet before importing.
Question is: How to delete all rows that have no data in column A and all columns starting from the O to XFD?
The code below works but for one file a time.
All red must be deleted.
Private Sub Comand_Click()
Dim FullPath As String
Dim oXL As Object, oWb As Object, oWs As Object
FullPath = "D:\Access\_Test_XlsImport\FileName.xlsx"
Set oXL = CreateObject("Excel.Application")
Set oWb = oXL.Workbooks.Open(FullPath)
Set oWs = oWb.Sheets("Worksheet_name")
oXL.Visible = True
With oWs
.Columns("O:XFD").Delete
.Rows("xx:xx").Delete ' <---problem to identify the starting point to delete below..
End With
oWb.Save
CleanUp:
oWb.Close False
oXL.Quit
Set oWb = Nothing
Set oXL = Nothing
Set oWs = Nothing
End Sub
I would pull out the oXL variable and make it global to your module so you only open it once.
Then put the other Excel objects into the subroutine that cleans the worksheets
Something like this should work - substitute your folder for the constant
The DIR command just matches all files that match the xlsx file spec and processes each of them in the loop
Just a warning - there is no check for files that have NO Data in
column A - if that happens the program will continue until all rows
have been exhausted.
EDIT - Modified to remove all empty rows up until last non-empty cell
Option Compare Database
Option Explicit
' Use these as global
Private oXL As Object
Private Sub Comand_Click()
Const SEARCH_FOLDER As String = "C:\Databases\"
Const EXCEL_FILES As String = "*.xlsx"
Dim FullPath As String
Dim strExcelFolder As String
Dim strFilename As String
' Open Excel
Set oXL = CreateObject("Excel.Application")
oXL.Visible = True
strFilename = Dir(SEARCH_FOLDER & EXCEL_FILES)
While strFilename <> ""
ProcessExcelFile SEARCH_FOLDER, strFilename
strFilename = Dir()
Wend
CleanUp:
oXL.Quit
Set oXL = Nothing
End Sub
Private Sub ProcessExcelFile(strExcelFolder As String, strExcelFile As String)
Dim oWb As Object, oWs As Object
Dim strFullPath As String
Dim LastRow As Long
strFullPath = strExcelFolder & strExcelFile
Set oWb = oXL.Workbooks.Open(strFullPath)
Set oWs = oWb.Sheets(1)
With oWs
LastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
.Columns("O:XFD").Delete
' Select All rows in Column A up to last filled row
.Range(“A1:A" & LastRow).Select
' Delete all rows with empty cell in A - up to last filled row
oXL.Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.Save
.Close False
End With
Set oWb = Nothing
Set oWs = Nothing
End Sub
I'm trying to write a macro in Outlook that reads an Excel file that has full paths and filenames in separate cells and inserts them as hyperlinks in an email.
I found information on how to create a hyperlink in Outlook. I can't find anything on how I Outlook would get the file paths from the Excel sheet.
Error says
Compile Error: User-defined type not defined
Sub links()
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Dim ExcelFileName As String
Dim FilePath As String
ExcelFileName = "C:\links.xlsx"
Set exWb = objExcel.Workbooks.Open(ExcelFileName)
FilePath = exWb.Sheets("Sheet1").Cells(1, 1)
oMsg.TextBody = Chr(34) & FilePath & Chr(34)
End Sub
In the Outlook VBA editor set a reference to Excel.
Tools | References
Tick Microsoft Excel Object Library
Add Option Explict to new modules. You will find this helpful.
Tools | Options | Editor tab
Tick Require Variable Declaration
.
Option Explicit
Sub links()
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Dim ExcelFileName As String
Dim FilePath As String
Dim oMsg As mailItem
ExcelFileName = "C:\links.xlsx"
Set exWb = objExcel.Workbooks.Open(ExcelFileName)
FilePath = exWb.Sheets("Sheet1").Cells(1, 1)
On Error Resume Next
Set oMsg = ActiveInspector.currentItem
On Error GoTo 0
If oMsg Is Nothing Then
Set oMsg = CreateItem(0)
oMsg.Display
End If
' This adds to existing text.
' Must display first to save a signature
'oMsg.body = Chr(34) & FilePath & Chr(34) & oMsg.body
'or
oMsg.HTMLBody = Chr(34) & FilePath & Chr(34) & oMsg.HTMLBody
ExitRoutine:
Set oMsg = Nothing
Set exWb = Nothing
Set objExcel = Nothing
End Sub