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
Related
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
I've written a program in Outlook VBA which creates emails dependent upon the contents of an Excel spreadsheet.
When the program terminates I continue to have an "EXCEL.EXE" process running which locks the spreadsheet so no-one else can open it.
Within the code I have three Excel objects:
Dim xl As Excel.Application
Dim xlwb As Excel.Workbook
Dim xlsheet As Excel.Worksheet
At the end I close the workbook and set all of the variables to Nothing:
xlwb.Close
Set xlsheet = Nothing
Set xlwb = Nothing
Set xl = Nothing
This is the bare bones of the code including the new "Quit" line:
Dim xl As Excel.Application
Dim xlwb As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim ol As Outlook.Application
Dim Mail As MailItem
Set xl = Excel.Application
Set ol = Outlook.Application
Set xlwb = xl.Workbooks.Open("C:\sheet.xlsx", ReadOnly)
For Each xlsheet In xlwb.Worksheets
for xlrow = 1 to 5
If xlsheet.Cells(xlRow, 1).Value = "John" Then
msg=msg & xlsheet.Cells(xlRow, 2).Value
end if
next
next
Set Mail = ol.CreateItem(olMailItem)
Mail.To = "A#b.c"
Mail.Subject = "John's email"
Mail.Body = msg
Mail.Send
xlwb.Close
xl.Quit
Set ol = Nothing
Set xlsheet = Nothing
Set xlwb = Nothing
Set xl = Nothing
you need to Quit the Application xl.Quit the Set "" = Nothing isn't really necessary
xl.quit
This will close the application (you are only closing the workbook and not the application in your code), so just put this before setting the variable to nothing.
Edit: Please change your sub to the following:
Dim xl As New Excel.Application
Dim xlwb As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim ol As Outlook.Application
Dim Mail As MailItem
Set ol = Outlook.Application
Set xlwb = xl.Workbooks.Open("C:\sheet.xlsx", ReadOnly)
For Each xlsheet In xlwb.Worksheets
For xlRow = 1 To 5
If xlsheet.Cells(xlRow, 1).Value = "John" Then
msg = msg & xlsheet.Cells(xlRow, 2).Value
End If
Next
Next
Set Mail = ol.CreateItem(olMailItem)
Mail.To = "A#b.c"
Mail.Subject = "John's email"
Mail.Body = msg
Mail.Send
xlwb.Close
xl.Quit
Set ol = Nothing
Set xlsheet = Nothing
Set xlwb = Nothing
Set xl = Nothing
You could try something like this
Option Explicit
Sub Excel()
'// Declare variables
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlStarted As Boolean
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
xlStarted = True
End If
' your code here
'// Close & SaveChanges
xlWb.Close SaveChanges:=True
If xlStarted Then
xlApp.Quit
End If
'// clean up
Set xlApp = Nothing
Set xlWb = Nothing
Set xlSheet = Nothing
End Sub
Here is my code, but for some reason it is failing on the saveas line (object does not support, etc).
Sub convertToXLS()
Dim wb As Object
Set wb = CreateObject("Excel.Application")
Dim strFile As String
strFile = "C:\path to my file\filename.csv"
wb.Workbooks.Open (strFile)
With wb
.SaveAs FileName:=Replace(strFile, ".csv", ".xls")
.Close True
End With
Set wb = Nothing
End Sub
In your code wb is Excel.Application object, rather than Excel.Workbook. And Excel.Application doesn't support SaveAs method. User this one instead:
Sub convertToXLS()
Dim xlApp As Object
Dim wb As Object
Dim strFile As String
Set xlApp = CreateObject("Excel.Application")
strFile = "C:\path to my file\filename.csv"
Set wb = xlApp.Workbooks.Open(strFile)
With wb
' where 56 is value of excel constant xlExcel8
.SaveAs FileName:=Replace(strFile, ".csv", ".xls"), FileFormat:=56
.Close True
End With
'clean up
Set wb = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub
I try to apply a VBA macro kept in personl.xls to all files in a given directory,
but I hit an error in line 29..
I'm afraid I got things mixed up here:
Option Explicit
On Error Resume Next
Dim xlApp
Dim xlBook
Dim No_Of_Files
Dim i
Dim File_Path
Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = True
File_Path = "C:\Dokumente und Einstellungen\kcichini\Eigene Dateien\Stuff\Test\"
With xlApp.FileSearch
.NewSearch
.LookIn = File_Path
.Filename = "*.xls"
.SearchSubFolders = False
.Execute
No_Of_Files = .FoundFiles.Count
For i = 1 To No_Of_Files
Set xlBook = xlApp.Workbooks.Open(.FoundFiles(i), 0, False)
xlApp.Run "'C:\Dokumente und Einstellungen\kcichini\Anwendungsdaten\Microsoft\Excel\XLSTART\PERSONL.XLS'!SASXLSFormat"
xlApp.ActiveWorkbook.Close
Next i
End With
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
I obviously was on a completedly wrong track.
But this seems to work properly:
Option Explicit
On Error Resume Next
Dim xlApp
Dim xlBook
Dim sPath
Dim fso
Dim ObjFolder
Dim ObjFiles
Dim ObjFile
'make an object with the excel application
Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = True
'Creating File System Object
Set fso = CreateObject("Scripting.FileSystemObject")
'Getting the Folder Object
Set ObjFolder = fso.GetFolder("C:\Dokumente und Einstellungen\kcichini\Eigene Dateien\Stuff\Test")
'Getting the list of Files
Set ObjFiles = ObjFolder.Files
'Running the macro on each file
For Each ObjFile In ObjFiles
'MsgBox (ObjFolder & "\" & ObjFile.Name)
Set xlBook = xlApp.Workbooks.Open(ObjFolder & "\" & ObjFile.Name, 0, False)
xlApp.Run "'C:\Dokumente und Einstellungen\kcichini\Anwendungsdaten\Microsoft\Excel\XLSTART\PERSONL.XLS'!SASXLSFormat"
xlApp.xlBook.Close
Next
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
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