I am trying to copy Word paragraphs to Excel cells, but I am hung up on
Runtime error 9: Subscript out of range.
I have searched. Everything I read says it cannot find the file, but the file is in the same folder, and the name is not mis-spelled, and the extension is correct. So, I am stumped. The original code comes from here: How to copy a formatted paragraph from Word 2013 to Excel?.
Private Sub Load_Schedule()
Dim ParaCount As Integer
Dim wDoc As Word.Document
Dim wb As Workbook
Dim ws As Worksheet
Set wDoc = ActiveDocument
Set wb = Workbooks("new.xlsm")
Set ws = wb.Sheets("Sheet1")
ws.Activate
ws.Columns(1).AutoFit
For ParaCount = 1 To wDoc.Paragraphs.Count
wDoc.Paragraphs(ParaCount).Range.FormattedText.Copy
Sheets(ws).Cells(ParaCount, 1).PasteSpecial
Paste:=xlPasteFormats
Next ParaCount
End Sub
The error comes on this line: Set wb = Workbooks("new.xlsm")
As you work with both applications, you should use full declarations like Word.Document and Excel.Workbook (if you already referenced the appropriate libraries).
An already opened Excel file can be referenced without path.
The Paste:= ... parameter belongs to the previous code line, so you have to add a blank + undersore at the end of the previous line or put them together into one line.
Please reference your worksheet's cell by ws.Cells ... and not by Sheets(ws), as your "ws" already is a worksheet object and not a string.
The further answer depends, if you run your code from Word-VBA or from Excel-VBA.
Word VBA
If you want to reference an Excel file from Word-VBA, you need the Excel.Application object additionally.
If Excel is already started, you can use the existing application object - otherwise you create one and make it visible.
Same with your Excel file: If it's already open, you use it - if not, you open it.
Private Sub LoadSchedule()
Dim ParaCount As Integer
Dim wDoc As Word.Document
Dim objExcel As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
On Error GoTo 0
If objExcel Is Nothing Then
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
End If
On Error Resume Next
Set wb = objExcel.Workbooks("new.xlsm")
On Error GoTo 0
If wb Is Nothing Then
Set wb = objExcel.Workbooks.Open(objExcel.DefaultFilePath & "\new.xlsm")
' or ThisDocument.Path or whatever path
End If
Set wDoc = ActiveDocument
Set ws = wb.Sheets("Sheet1")
For ParaCount = 1 To wDoc.Paragraphs.Count
wDoc.Paragraphs(ParaCount).Range.FormattedText.Copy
ws.Cells(ParaCount, 1).PasteSpecial Paste:=xlPasteFormats
Next ParaCount
ws.Columns(1).AutoFit
'ws.Activate
End Sub
Excel VBA
In Excel you can try to reference an already opened Word file directly as ActiveDocument without getting the Word.Application additionally.
Private Sub LoadSchedule()
Dim ParaCount As Integer
Dim wDoc As Word.Document
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
On Error Resume Next
Set wb = Workbooks("new.xlsm")
On Error GoTo 0
If wb Is Nothing Then
Set wb = Workbooks.Open(Application.DefaultFilePath & "\new.xlsm")
End If
Set wDoc = ActiveDocument
Set ws = wb.Sheets("Sheet1")
For ParaCount = 1 To wDoc.Paragraphs.Count
wDoc.Paragraphs(ParaCount).Range.FormattedText.Copy
ws.Cells(ParaCount, 1).PasteSpecial Paste:=xlPasteFormats
Next ParaCount
ws.Columns(1).AutoFit
'ws.Activate
End Sub
You need to specify the full path to the excel file - you say it's the same as the word document so this will work:
Sub GetXLFileInWord()
Dim xl As Excel.Application
Set xl = New Excel.Application
Dim wb As Excel.Workbook
Set wb = xl.Documents.Open(ThisDocument.Path & "\new.xlsm")
Related
I'm running a query from Access and exporting the results to Excel. Works just like I expect it to. What I would like to do next is manipulate the Excel file (autofit columns, format fields, etc.). I've manipulated Excel worksheets countless times from Excel. However this is the first time, doing it from Access. Below is the code I'm using. The query and export run great.
My issue is I'm unable to select / activate / manipulate Excel. Currently, the only Excel file open is the query result. However, I'm sure my user's will have multiple Excel files open, so I'll need to program for that situation as well.
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, , True
Set xlapp = GetObject(, "Excel.Application")
MyReport = ""
MyReport = xlapp.workbooks(w).Name
xlapp.Workbook(MyReport).Activate
xlapp.Workbook(MyReport).worksheets(1).Activate
Range(xlapp.Workbook(MyReport).worksheets(1).cells(1, 1), xlapp.Workbook(MyReport).worksheets(1).cells(1, 1)).Select
Any help or suggestions would be greatly appreciated. Thanks in advance for your assistance.........
You can start with something like this. Have fun!
With EarlyBinding:
Sub Access_ControlExcelWorkbook_EarlyBinding()
On Error GoTo errHandler
Dim appExcel As New Excel.Application
Dim xWb As Excel.Workbook
Dim xWs As Excel.Worksheet
Dim xRng As Excel.Range
Dim wbPath As String: wbPath = "YourWorkbookPath"
' Exit if workbook don't exist
If Len(Dir(wbPath)) = 0 Then Exit Sub
' Open workbook
Set xWb = appExcel.Workbooks.Open(wbPath)
' Show Excel
appExcel.Visible = True
' Sheet to control
Set xWs = xWb.Worksheets("Sheet1")
' Range to control
Set xRng = xWs.Range("A10")
' Write value in range
xRng.Value = "Control from Access"
' Auto fit columns
xWs.Cells.EntireColumn.AutoFit
' Save workbook
xWb.Save
exitRoutine:
' Close workbook
xWb.Close False
' Close Excel
appExcel.Quit
Exit Sub
errHandler:
Debug.Print Err.Description
Resume exitRoutine
End Sub
With Late Binding:
Public Const xlCenter = -4108
Sub Access_ControlExcelWorkbook_LateBinding()
On Error GoTo errHandler
Dim appExcel As Object
Dim xWb As Object
Dim xWs As Object
Dim xRng As Object
Dim wbPath As String: wbPath = "YourWorkbookPath"
' Exit if workbook don't exist
If Len(Dir(wbPath)) = 0 Then Exit Sub
' Create an instance od Excel
Set appExcel = CreateObject("Excel.Application")
' Copy the rest of the code from early Binding
' Center column G
xWs.Columns("G:G").HorizontalAlignment = xlCenter
End Sub
New to VBA here.
I'm trying to recover the reference of a Excel Workbook from a Collection and SOMETIMES I end with the error 91 "Object variable or With block variable not set"
Using the function "apriData()" I should have as a result a collection where:
coll[1] = reference to the WB opened from an excel file;
coll[2] = reference to the appExcell.
Function apriData() As Collection
Dim appExcel As Application
Dim coll As Collection
Set coll = New Collection
Dim wb As Workbook
Dim wsData As Worksheet
Dim ws As Worksheet
Dim i As Integer
'create new excel application object
Set appExcel = New Application
'set the applications visible property to false
appExcel.Visible = False
'open the workbook with data
On Error GoTo Error1
Set wb = appExcel.Workbooks.Open("PATH OF THE EXCEL FILE TO SAVE THE WB - CENSORED")
On Error GoTo Error2
MsgBox ("DATA aperto")
coll.Add wb
coll.Add appExcel
Set apriData = coll
Exit Function
Error1:
'close the application
appExcel.Quit
Exit Function
Error2:
'close the workbooks
wb.Close
'close the application
appExcel.Quit
Exit Function
End Function
This function is used in my formatta() method to save the collection retrived from the apriData() and use the selected WB.
Here it's the code:
Sub formatta()
Dim collectionData As Collection
Set collectionData = New Collection
Dim wb As Workbook
Dim wbData As Workbook
Dim app As Application
Dim ws As Worksheet
Dim sheetCount As Integer
Dim i As Integer
Dim target As Range
Set wb = ActiveWorkbook
sheetCount = wb.Worksheets.Count
For i = 1 To sheetCount
If Sheets(i).Name = "CE" Then
Sheets(i).Cells.Clear
End If
Next i
Set ws = wb.Worksheets(2)
ws.Name = "CE"
Set target = ws.Range("A1")
Set collectionData = apriData
Set wbData = collectionData(1)
Set app = collectionData(2)
creaGriglia wbData
popolaGriglia wbData
'close the workbooks
wbData.Close
'close the application
app.Quit
End Sub
I think the problem could be the "Set collectionData = apriData" not referencing the correct WB value.
Thank you for every support.
I'm trying to copy word(s) from my word document to a specific cell in the excel workbook. I've used Bookmark to find the text i need and copy that then i open the workbook to paste to a specific cell - which is a vlookup reference.
My code runs but the pasting does not actually occur. I know the copy portion of the code works because when i run up until that point then manually paste the selection, it works just fine. I've tried multiple options of pasting but nothing has worked so far...
Selection. Paste
Selection.PasteSpecial (xlPasteAll)
Selection.PasteSpecial (xlPasteValues)
Here is my code:
Sub copypastewordtoexcel()
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String
ActiveDocument.Bookmarks("Name").Select
Selection.Copy
WorkbookToWorkOn = "C:\Users\arboari\Desktop\Book1.xlsx"
Set oXL = GetObject(, "Excel.Application")
Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)
ActiveDocument.Bookmarks("Name").Select
Selection.Copy
For Each oSheet In oXL.ActiveWorkbook.Worksheets
oSheet.Range("A1").Select
Selection.PasteSpecial (xlPasteValue)
Next oSheet
Set oRng = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing
End Sub
I'm not sure what i'm doing wrong but i'd appreciate some guidance on this!
Thanks!
Should not need copy/paste: you can assign directly
Sub copypastewordtoexcel()
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String
WorkbookToWorkOn = "C:\Users\arboari\Desktop\Book1.xlsx"
Set oXL = GetObject(, "Excel.Application")
Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)
For Each oSheet In oXL.ActiveWorkbook.Worksheets
oSheet.Range("A1").Value = ActiveDocument.Bookmarks("Name").Range.Text
Next oSheet
End Sub
EDIT: reading from a table cell
txt = ActiveDocument.Tables(1).Cell(1, 1).Range.Text
oSheet.Range("A1").Value = Left(txt, Len(txt)-2)
You need to strip off the two-character "end of cell" marker.
I am copying a table from Outlook to Excel. The code I have found online copies the table in a new Excel file.
I want to copy the table into an existing Excel file.
Here is the code I am running in Outlook.
Sub dd()
Dim item As MailItem, x%
Dim r As Object 'As Word.Range
Dim doc As Object 'As Word.Document
Dim xlApp As Object, wkb As Object
Set xlApp = CreateObject("Excel.Application")
Set wkb = xlApp.Workbooks.Add
xlApp.Visible = True
Dim wks As Object
Set wks = wkb.Sheets(1)
For Each item In Application.ActiveExplorer.Selection
Set doc = item.GetInspector.WordEditor
For x = 1 To doc.Tables.Count
Set r = doc.Tables(x)
r.Range.Copy
wks.Paste
wks.Cells(wks.Rows.Count, 1).End(3).Offset(1).Select
Next
Next
End Sub
The code here
Set wkb = xlApp.Workbooks.Add
is what opens the new workbook. Try replacing this line with something like
Set wkb = xlApp.Workbooks.Open("C:\PathToExcel\File.xlsx")
I have a form that exports and edits excel files for users. I have an issue when trying to have my code delete an existing worksheet from my Access 2010 VBA code.
My Code:
Private Sub Command0_Click()
Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim sht As Excel.Worksheet
Set xl = CreateObject("Excel.Application")
Set wb = xl.Workbooks.Open("C:\Users\Me\Desktop\Document.xlsx")
For Each sht In wb.Worksheets
If sht.Name = "DeleteSheet" Then
wb.Worksheets("DeleteSheet").Delete
End If
Next sht
wb.Save
wb.Close
xl.Quit
End Sub
When I run the code, there is no error. However, the sheet does not get deleted. I know that sht.Name does read the sheet name "DeleteSheet", allowing the if statement to run. So, I believe it comes down to either the saving method or this line: wb.Worksheets("DeleteSheet").Delete. TIA!
Can you delete the worksheet directly, i.e.
Instead of
wb.Worksheets("DeleteSheet").Delete
Use
sht.Delete
Can you try something like this, Ryan?
Dim xl As Object
Dim wb As Excel.Workbook
Dim sht As Excel.Worksheet
Set xl = CreateObject("Excel.Application")
xl.Application.DisplayAlerts=False
Set wb = xl.Workbooks.Open("C:\Users\Me\Desktop\Document.xlsx")
For Each sht In wb.Worksheets
If sht.Name = "DeleteSheet" Then
wb.Worksheets("DeleteSheet").Select
xl.ActiveSheet.Delete
End If
Next sht
wb.Save
wb.Close
xl.Quit