I am running a few modules of code in access and am writing data into
Excel. When I write the first time, data gets written properly. But again
when I try, the new data is written on top of the old data. What should I do to
insert a new sheet?
My existing code is
Dim objexcel As Excel.Application
Dim wbexcel As Excel.Workbook
Dim wbExists As Boolean
Dim objSht As Excel.Worksheet
Dim objRange As Excel.Range
Set objexcel = CreateObject("excel.Application")
On Error GoTo Openwb
wbExists = False
Set wbexcel = objexcel.Workbooks.Open("C:\REPORT1.xls")
Set objSht = wbexcel.Worksheets("Sheet1")
objSht.Activate
wbExists = True
Openwb:
On Error GoTo 0
If Not wbExists Then
objexcel.Workbooks.Add
Set wbexcel = objexcel.ActiveWorkbook
Set objSht = wbexcel.Worksheets("Sheet1")
End If
I think that the following code should do what you want. It's very similar to yours, except it uses the return values from the .Add methods to get the objects you want.
Public Sub YourSub()
Dim objexcel As Excel.Application
Dim wbexcel As Excel.Workbook
Dim wbExists As Boolean
Set objexcel = CreateObject("excel.Application")
'This is a bad way of handling errors. We should'
'instead check for the file existing, having correct'
'permissions, and so on, and actually stop the process'
'if an unexpected error occurs.'
On Error GoTo Openwb
wbExists = False
Set wbexcel = objexcel.Workbooks.Open("C:\REPORT1.xls")
wbExists = True
Openwb:
On Error GoTo 0
If Not wbExists Then
Set wbexcel = objexcel.Workbooks.Add()
End If
CopyToWorkbook wbexcel
EndSub
Private Sub CopyToWorkbook(objWorkbook As Excel.Workbook)
Dim newWorksheet As Excel.Worksheet
set newWorksheet = objWorkbook.Worksheets.Add()
'Copy stuff to the worksheet here'
End Sub
Related
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")
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 the following bit of code which opens up an Excel sheet, carries our some procedures and then shuts the sheet.
I am having trouble shutting the sheet!
Dim xlApp As Object
Dim xlWorkBook As Object
Dim path As String
Dim osh As Shape
Dim filename As String
Set xlApp = CreateObject("Excel.Application")
path = "path"
filename = "Name.xlsx"
xlApp.Visible = True
Set xlWorkBook = xlApp.Workbooks.Open(path & filename)
Set positionsheet = xlWorkBook.Sheets("Sheet1")
Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
'does stuff here
ActiveWindow.Visible = False
With xlApp ' I think the error is here!!!
.xlWorkBook.Save
.xlWorkBook.Close
End With
For some reason the sheet doesn't close! Any ideas??
Try using this:
xlworkbook.close
The With-Block throws an error, since xlWorkBook is not a parameter of xlApp.
This works in my test:
' ...
'does stuff here
'NoWith Block!
xlWorkBook.Save
xlWorkBook.Close
xlApp.Quit
Example
Option Explicit
Public Sub Example()
Dim xlApp As Object
Dim xlWorkBook As Object
Dim Sht As Object
Dim xlStarted As Boolean
Dim Path As String
Dim FileName As String
Path = "C:\Temp\"
FileName = "Book1.xlsx"
Set xlApp = CreateObject("Excel.Application")
xlStarted = True
xlApp.Visible = True
Set xlWorkBook = xlApp.Workbooks.Open(Path & FileName)
Set Sht = xlWorkBook.Sheets("Sheet1")
'does stuff here
'// Close & SaveChanges
xlWorkBook.Close SaveChanges:=True
If xlStarted Then
xlApp.Quit
End If
End Sub
I want to call a function that returns a Workbook or reference to that workbook. However I'm unable to set the value 'wb' with the workbook returned from the function.
Public Sub TestScript()
Dim wb As Workbook
wb = GetWorkBook()
End Sub
Function GetWorkBook() As Workbook
Dim db2 As Workbook
Dim xlApp As Excel.Application
Set xlApp = GetObject(, "Excel.Application")
Dim xlWB As Excel.Workbook
For Each xlWB In xlApp.Workbooks
If xlWB.Name = "Test.XLSX" Then
Set db2 = xlWB
End If
Next xlWB
Set xlApp = Nothing
Set xlWB = Nothing
GetWorkBook = db2
End Function
Gives:
Runtime Error 91:
Object Variable or With Block Variable not set
You forgot to use the set statement two times:
Public Sub TestScript()
Dim wb As Workbook
Set wb = GetWorkBook()
End Sub
Function GetWorkBook() As Workbook
Dim db2 As Workbook
Dim xlApp As Excel.Application
Set xlApp = GetObject(, "Excel.Application")
Dim xlWB As Excel.Workbook
For Each xlWB In xlApp.Workbooks
If xlWB.Name = "Test.XLSX" Then
Set db2 = xlWB
End If
Next xlWB
Set xlApp = Nothing
Set xlWB = Nothing
Set GetWorkBook = db2
End Function
Whenever you are assigning an object to a variable (reference it thereby) then you have to use the set statement (https://stackoverflow.com/a/349636/1153513).
Examples:
Set rngYourRangeVariable = Thisworkbook.Worksheets("Sheet1").Range("A1:C4")
Set shtSomeSheet = Thisworkbook.Worksheet("Sheet1")
Set conSomeADOconnection = New ADODB.Connection
This problem has consumed a lot of my time now. Everytime I run code from access to launch excel read file location and then open the excel on that file location, make changes and close. I see that this leaves an orphan excel process. I have tried all ways of referencing and possible solutions suggested out on internet, but nothing to help. My code as below. Any help or suggestions would be great:
Public Sub productdetailprinter()
Dim i As Double
Dim dbs As DAO.Database
Dim recSet As Recordset
Dim wb As Workbook
Dim ws As Worksheet
Dim tableName As String
Dim recTable As Recordset
Dim fld As DAO.Field
Dim k As Integer
Dim r As Integer
Dim intformat As Integer
Dim wrksht As Worksheet
Dim wrkbk As Workbook
Dim filelocation As String
Dim xl As Excel.Application
Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set dbs = CurrentDb
Set recSet = dbs.OpenRecordset("tbl_formList")
Set wrkbk = xl.Workbooks.Open("<location>")
Set wrksht = wrkbk.Worksheets("databaselinks")
filelocation = wrksht.Range("C5").Value
wrkbk.Close
xl.Quit
Set wrksht = Nothing
Set wrkbk = Nothing
Set xl = Nothing
Set xl = CreateObject("Excel.Application")
xl.Visible = True
xl.Workbooks.Application.DisplayAlerts = False
xl.Workbooks.Application.AskToUpdateLinks = False
Set wb = xl.Workbooks.Open(filelocation & "\product_detail.xlsx")
Set ws = wb.Worksheets("details")
xl.Workbooks.Application.AskToUpdateLinks = True
xl.Workbooks.Application.DisplayAlerts = True
ws.Range("B3", Range("B3").End(xlDown)).Select
xl.Selection.Clear
ws.Range("C3", Range("C3").End(xlDown)).Select
xl.Selection.Clear
ws.Range("D3", Range("D3").End(xlDown)).Select
xl.Selection.Clear
i = ws.Columns("B").End(xlDown).Row
i = i + 1
Do Until recSet.EOF
'code lines
recSet.MoveNext
Loop
ws.Save
wb.Close
xl.Quit
Set xl = Nothing
Set ws = Nothing
Set wb = Nothing
recTable.Close
recSet.Close
End Sub
You must close the objects in exact reverse order:
' Also:
Dim rng As Excel.Range
Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set wrkbk = xl.Workbooks.Open("<location>")
Set wrksht = wrkbk.Worksheets("databaselinks")
Set rng = wrksht.Range("C5")
filelocation = rng.Value
Set rng = Nothing
Set wrksht = Nothing
wrkbk.Close
Set wrkbk = Nothing
xl.Quit
Set xl = Nothing
This is tested and works at me:
Public Sub EditWorkSheet()
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim Column As Integer
Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open("c:\test\test.xlsx")
Set wks = wkb.Worksheets(1)
Set rng = wks.Range("C5")
rng.Value = 4
wkb.Close True, "c:\test\test1.xlsx"
Set rng = Nothing
Set wks = Nothing
Set wkb = Nothing
xls.Quit
Set xls = Nothing
End Sub
Thank you for proposed solutions. After spending 4 hours on this.. I realized that vba wasnt happy with the way I was referencing the ranges.
ws.Range("B3", Range("B3").End(xlDown)).Select
should be referenced as
ws.Range(ws.Range("B3"), ws.Range("B3").End(xlDown)).Select
It works like a charm.. Excel instances die and no more errors.
Hope this saves someones time out there.
Thank You