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.
Related
I want to export data from selected Outlook emails to a workbook. Each email's data (subject, body, etc.) should be stored in a different worksheet.
I'm trying to edit this macro because it is almost what I need—and especially the part of olFormatHTML and WordEditor—because of split.
The idea is
Select multiple emails in Outlook
Open file path
Data for each email selected will be stored in a single worksheet from file opened
The issue with the macro is in this third part
From the selected items, the macro does a loop and just takes the first email selected,
The data is stored in different workbooks; it should be stored in the same workbook that I opened.
Public Sub SplitEmail()
Dim rpl As Outlook.MailItem
Dim itm As Object
Dim sPath As String, sFile As String
Dim objDoc As Word.Document
Dim txt As String
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim i As Long
Dim x As Long
'----------------------------
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Set myOlExp = Application.ActiveExplorer
Set myOlSel = myOlExp.Selection
For x = 1 To myOlSel.Count
'----------------------------------------------
Set itm = GetCurrentItem() 'A)I think the issuefrom selecting 1 item is located here
'|||||||||||||||||||||||||||||||||||||||||
sPath = "C:\Users\Ray\"
sFile = sPath & "Macro.xlsm"
If Not itm Is Nothing Then
Set rpl = itm.Reply
rpl.BodyFormat = olFormatHTML
'rpl.Display
End If
Set objDoc = rpl.GetInspector.WordEditor
txt = objDoc.Content.Text
'||||||||||||||||||||||||||||||||||||||||||||||
Set xlApp = CreateObject("Excel.application")
xlApp.Visible = True
Set wb = xlApp.Workbooks.Open(sFile) 'B) tried to move it to the beginning and macro doesn't work
'||||||||||||||||||||||||||||||||||||||||||||||
For i = LBound(Split(txt, Chr(13)), 1) To UBound(Split(txt, Chr(13)), 1)
wb.Worksheets(x).Range("A" & i + 1).Value = Split(txt, Chr(13))(i) 'B)emails in diferrent sheet but no same workbook
Next i
'------------------------------------------------------
Next x
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
GetCurrentItem.UnRead = False
Set objApp = Nothing
End Function
I made an update to this macro
as macro do loop in For x it open the file x times,
and then close it and open again instead of working on the first workbook opened
but the macro leaves open instances
here is the current code
Public Sub SplitEmail()
Dim rpl As Outlook.MailItem
Dim itm As Object
Dim sPath As String, sFile As String
Dim objDoc As Word.Document
Dim txt As String
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim i As Long
Dim x As Long
'----------------------------
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Set myOlExp = Application.ActiveExplorer
Set myOlSel = myOlExp.Selection
For x = 1 To myOlSel.Count
'----------------------------------------------
Dim objApp As Outlook.Application
Dim GetCurrentItem As Object
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.item(x)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
GetCurrentItem.UnRead = False
Set objApp = Nothing
'-----------------------------------------------
Set itm = GetCurrentItem
sPath = "C:\Users\Ray\"
sFile = sPath & "Macro.xlsm"
If Not itm Is Nothing Then
'de lo contrario, se crea un Reply del correo en formato HTML
Set rpl = itm.Reply
rpl.BodyFormat = olFormatHTML
'rpl.Display
End If
Set objDoc = rpl.GetInspector.WordEditor
txt = objDoc.Content.Text
'||||||||||||||||||||||||||||||||||||||||||||||
Set xlApp = CreateObject("Excel.application")
xlApp.Visible = True
Set wb = xlApp.Workbooks.Open(sFile)
xlApp.Windows("Macro.xlsm").Activate
'Set wb = ActiveWorkbook
'||||||||||||||||||||||||||||||||||||||||||||||
For i = LBound(Split(txt, Chr(13)), 1) To UBound(Split(txt, Chr(13)), 1)
wb.Worksheets(x).Range("A" & i + 1).Value = Split(txt, Chr(13))(i)
Next i
xlApp.Windows("Macro.xlsm").Close SaveChanges:=True
xlApp.Workbook.Close SaveChanges:=False
'------------------------------------------------------
Next x
'------------------------------------------------------
'the instances should closed but not working, instances are empty
For Each wb In xlApp
wb.Close SaveChanges:=False
Next
End Sub
done, I added xlApp.Quit after saving files and deleted the last part For Each wb In xlApp...
I am trying to automatically fill in tables in a MS word file by retrieving data in various excel tables. In order to properly interact with Excel it would be very handy to work with worksheetfunction. Yet since the macro is in MS Word I am getting blocked. Any way to access it? Cheers
Dim src As Workbook
Dim ws As Worksheet
Dim t As String
Dim c As Integer
t = ThisDocument.Tables(1).Cell(1, 1).Range.Text
t = Left(t, Len(t) - 1)
Set src = workbooks.Open("https://collab.ext.../asd.xlsx", True, True)
Set ws = src.Worksheets("Data")
c = worksheetfunction.Match(t, ws.Range("A1:AA1"), False)
src.Close
Set src = Nothing
#Tim Williams thanks for your help. Corrected code below:
Dim oXL As Object
Dim oWB As Workbook
Dim oWS As Worksheet
Dim wbPath As String
Dim t As String
Dim c As Integer
Set oXL = CreateObject("Excel.Application")
oXL.Visible = False
wbPath = "https://collab.ext...asd.xlsx"
t = ThisDocument.Tables(1).Cell(1, 1).Range.Text
t = Left(t, Len(t) - 2)
Set oWB = oXL.workbooks.Open(wbPath, True, True)
Set oWS = oWB.Sheets("Data")
c = oXL.worksheetfunction.Match(t, oWS.Range("A1:AA3"), False)
oXL.ActiveWorkbook.Close SaveChanges:=False
oXL.Application.Quit
Set oXL = Nothing
Set oWB = Nothing
Set oWS = Nothing
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)
I have been unsuccessful in setting the row height and column widths of an excel spreadsheet from within a visual basic application.
I have a visual basic application where I have data in my clipboard. I copy that code to an instance of excel and then have excel save the resulting spreadsheet and then excel closes. I am trying to programmatically set the row heights and cell widths prior to saving the spreadsheet but have been unable to do so. This is the code that I am executing:
If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
oXL = CreateObject("Excel.Application")
oXL.Visible = True
oWB = oXL.Workbooks.Add
oSheet = oWB.ActiveSheet
oSheet.Paste()
oSheet.Cells.Select()
oSheet.Selection.RowHeight = 11.4
oSheet.Cells.EntireColumn.AutoFit()
oSheet = Nothing
oWB.Close(True, SaveFileDialog1.FileName)
oWB = Nothing
oXL.Quit()
oXL = Nothing
MsgBox("Finished!")
End If
The application runs without the oSheet.Cells.Select(), oSheet.Selection.RowHeight = 11.4, and oSheet.Cells.EntireColumn.AutoFit()
lines. With these lines, I get this error dialog message:
Public member 'Selection' on type 'Worksheet' not found.
When I trace the program in Visual Studio, the oSheet.Paste() command executes and the oSheet.Cells.Select() command executes. The exception is generated when I try to execute the oSheet.Selection.RowHeight = 11.4 command.
Any assistance would be greatly appreciated.
Jonathan
The following is not late binding, it's early binding but the pattern should work with minor code changes.
Option Strict On
Imports Excel = Microsoft.Office.Interop.Excel
Imports System.Runtime.InteropServices
Imports System.IO
Public Class Operations
Public HasError As Boolean
Public ErrorMessage As String
''' <summary>
'''
''' </summary>
''' <param name="FileName">Path and file name for Excel file</param>
''' <param name="SheetName">Sheet name to work on</param>
''' <param name="RowHeight">Used to set row height in SheetName</param>
''' <returns></returns>
Public Function SetWidthHeight(
ByVal FileName As String,
ByVal SheetName As String,
ByVal RowHeight As Integer) As Boolean
If File.Exists(FileName) Then
Dim Proceed As Boolean = False
Dim xlApp As Excel.Application = Nothing
Dim xlWorkBooks As Excel.Workbooks = Nothing
Dim xlWorkBook As Excel.Workbook = Nothing
Dim xlWorkSheet As Excel.Worksheet = Nothing
Dim xlWorkSheets As Excel.Sheets = Nothing
Dim xlCells As Excel.Range = Nothing
xlApp = New Excel.Application
xlApp.DisplayAlerts = False
xlWorkBooks = xlApp.Workbooks
xlWorkBook = xlWorkBooks.Open(FileName)
xlApp.Visible = False
xlWorkSheets = xlWorkBook.Sheets
For x As Integer = 1 To xlWorkSheets.Count
xlWorkSheet = CType(xlWorkSheets(x), Excel.Worksheet)
If xlWorkSheet.Name = SheetName Then
Proceed = True
Exit For
End If
Marshal.FinalReleaseComObject(xlWorkSheet)
xlWorkSheet = Nothing
Next
If Proceed Then
xlCells = xlWorkSheet.Cells
xlCells.PasteSpecial()
Dim EntireRow As Excel.Range = xlCells.EntireRow
'
' Set row height
'
EntireRow.RowHeight = RowHeight
Dim ColRange = xlCells.EntireColumn
'
' Auto fit all columns
'
ColRange.AutoFit()
ReleaseComObject(ColRange)
ReleaseComObject(xlCells)
ReleaseComObject(EntireRow)
Else
HasError = True
ErrorMessage = SheetName & " not found."
End If
xlWorkSheet.SaveAs(FileName)
xlWorkBook.Close()
xlApp.UserControl = True
xlApp.Quit()
ReleaseComObject(xlWorkSheets)
ReleaseComObject(xlWorkSheet)
ReleaseComObject(xlWorkBook)
ReleaseComObject(xlWorkBooks)
ReleaseComObject(xlApp)
Else
HasError = True
ErrorMessage = "'" & FileName &
"' not located. Try one of the write examples first."
End If
Return HasError
End Function
Private Sub ReleaseComObject(ByVal excelObject As Object)
Try
If excelObject IsNot Nothing Then
Marshal.ReleaseComObject(excelObject)
excelObject = Nothing
End If
Catch ex As Exception
excelObject = Nothing
End Try
End Sub
End Class
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