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)
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 have an excel sheet that essentially hold a list of user information for a standard document that we have to send out regularly. I'm trying to make it easy choose / type some info into excel, click a button then transfer to the data over to a word document.
In the word document, i have a number of "tags" that i had hoped to use to transfer the information over.
I'm running into problems where the contentcontrol code in word is not available in excel.
Should i just use word-vba and user-forms instead?
Option Explicit
Option Base 1
Dim this_wb_name As String, dos_doc_name As String, dos_doc_path As
String, tempname As String, temppath As String
Private Sub transfer_button_Click()
Dim start_cell As Range
Dim i As Long
Dim i_tags As Long
Dim tag_name As String
Dim tag_value As String
Dim wb As Workbook
Dim ws_tags As Worksheet
Dim ws_entry As Worksheet
Dim wordapp As Object
Dim worddoc As Object
Dim count As Long
''''''''''''''opening up the word document'''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim file_open As String
file_open = ""
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
this_wb_name = ActiveWorkbook.Name
'opens a dialog box to select the input
With fd
.Title = "Select a DOS template"
If .Show = -1 Then
file_open = fd.SelectedItems.Item(1)
End If
End With
If file_open = "" Then
MsgBox ("No file selected.")
Exit Sub
End If
'setting the DOS document
Set wordapp = CreateObject("Word.Application")
With wordapp
.Visible = True
Set worddoc = wordapp.documents.Open(file_open)
.Activate
End With
dos_doc_name = worddoc.Name
dos_doc_path = file_open
ThisWorkbook.Worksheets("DOS Setup Entry").Range("G11").Value = dos_doc_name
ThisWorkbook.Worksheets("DOS Setup Entry").Range("G12").Value = dos_doc_path
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''transferring files.
Dim ccs As Control
Dim cc As Control
Set wb = ThisWorkbook
Set ws_tags = wb.Worksheets("tags")
Set ws_entry = wb.Worksheets("DOS Setup Entry")
For i = 3 To 36
If ws_tags.Range("B" & i).Value = "" Then
GoTo endline
Else
tag_name = ws_tags.Range("B" & i).Value
tag_value = ws_tags.Range("D" & i).Value
count = worddoc.SelectContentControlsByTag(tag_name).count
For i_tags = 1 To count
worddoc.SelectContentControlsByTag(tag_name).Item(i_tags).Range.Text = tag_value
Next
End If
endline:
Next
This is what is not working.
"worddoc.SelectContentControlsByTag(tag_name).Item(i_tags).Range.Text = tag_value"
Thank you everyone for your help,
Unfortunately I believe the issue was the ws_tags worksheet. The code ended up working without many changes.
thank you for your time,
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.
I'm exporting filtered results from my subform to Excel, and naming Excel file as I want. Here's my code :
Sub XcelExport()
Dim Results As Recordset
Dim RecCount As Integer
Dim XcelFileName As String
Dim FilePath As String
Dim wb As Excel.Workbook
Dim XcelFile As Excel.Application
'Set name of file with date
XcelFileName = "MySubform_Results_" & Format(Date, "dd/mm/yyyy") & ".xlsx"
' Set destinaton folder of saved file
FilePath = CurrentProject.Path & "\" & XcelFileName
Set XcelFile = New Excel.Application
Set wb = XcelFile.Workbooks.Add
'Fetch subform record source
Set Results = Forms![MainForm]![MySubform].Form.RecordsetClone
With wb
XcelFile.ScreenUpdating = False
' Add field names to workbook
For RecCount = 0 To Results.Fields.Count - 1
XcelFile.Cells(1, RecCount + 1).Value = Results.Fields(RecCount).Name
Next RecCount
' Copy subform results to Excel file
XcelFile.Range("A2").CopyFromRecordset Results
.SaveAs Filename:=FilePath, FileFormat:=51
XcelFile.ScreenUpdating = True
.Close
End With
Set XcelFile = Nothing
Set Results = Nothing
End Sub
Code works, with one flaw. When I run it again, it creates a new file again, but .RecordsetClone is gone, so values from Subform are not exported again. Beside that, I find it very strange that code works, just take a look at »with wb« statement – I had to reference to XcelFile on certain commands or they didn't work, regardless I allready set wb to XcelFile in code above (Set wb = XcelFile.Workbooks.Add). What Is wrong in my code, does anybody have a better solution ???
So this is final code, I hope It will be useful to someone else too.
Sub XcelExport()
Dim Results As Recordset
Dim RecCount As Integer
Dim XcelFileName As String
Dim FilePath As String
Dim wb As Excel.Workbook
Dim XcelFile As Excel.Application
'Set name of file with date
XcelFileName = "MySubform_Results_" & Format(Date, "dd/mm/yyyy") & ".xlsx"
' Set destinaton folder of saved file
FilePath = CurrentProject.Path & "\" & XcelFileName
Set XcelFile = New Excel.Application
Set wb = XcelFile.Workbooks.Add
'Fetch subform record source
Set Results = Forms![MainForm]![MySubform].Form.RecordsetClone
With wb
XcelFile.ScreenUpdating = False
' Add field names to workbook
For RecCount = 0 To Results.Fields.Count - 1
XcelFile.Cells(1, RecCount + 1).Value = Results.Fields(RecCount).Name
Next RecCount
' Copy subform results to Excel file and set Results to first row
Results.Movefirst
XcelFile.Range("A2").CopyFromRecordset Results
.SaveAs Filename:=FilePath, FileFormat:=51
XcelFile.ScreenUpdating = True
.Close
End With
Set XcelFile = Nothing
Set Results = Nothing
End Sub
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