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
Related
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 am trying to create a button in a .xlsm that will convert each of the ~100 .xlsx files in the myFolder directory to .txt. The below VBA code returns an Expected End Suberror. The data is always in `Sheet 1" even though there may be other sheets present.
The Dos command executes and converts the files but they are unreadable (something to do with excels formatting?). I am not sure what to do? Thank you :)
Dos
cd C:\Users\Desktop\folder
Copy *.xlsx *.txt
VBA
Option Explicit
Private Sub CommandButton1_Click()
Dim oFSO, myFolder
Dim xlText
myFolder = "C:\Users\Desktop\folder"
Set oFSO = CreateObject("Scripting.FileSystemObject")
xlText = -4158 'Excel txt format enum
Call ConvertAllExcelFiles(myFolder)
Set oFSO = Nothing
Call MsgBox("Done!")
Sub ConvertAllExcelFiles(ByVal oFolder)
Dim targetF, oFileList, oFile
Dim oExcel, oWB, oWSH
Set oExcel = CreateObject("Excel.Application")
oExcel.DisplayAlerts = False
Set targetF = oFSO.GetFolder(oFolder)
Set oFileList = targetF.Files
For Each oFile In oFileList
If (Right(oFile.Name, 4) = "xlsx") Then
Set oWB = oExcel.Workbooks.Open(oFile.Path)
For Each oWSH In oWB.Sheets
Call oWSH.SaveAs(oFile.Path & ".txt", FileFormat:=xlTextWindows)
Next
Set oWSH = Nothing
Call oWB.Close
Set oWB = Nothing
End If
Next
Call oExcel.Quit
Set oExcel = Nothing
End Sub
The first lines of your code belong in Private Sub CommandButton1_Click()
(it has to be closed by End Sub)
Option Explicit and proper code indentation can help in this situation
Try this version:
Option Explicit
Private Sub CommandButton1_Click()
Dim myFolder As String
myFolder = "C:\Users\Desktop\folder"
ConvertAllExcelFiles myFolder
MsgBox "Done!"
End Sub
Public Sub ConvertAllExcelFiles(ByVal folderPath As String)
Dim xlApp As Object, wb As Workbook, ws As Variant, fso As Object
Dim fileList As Object, itm As Object, fileName As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set fileList = fso.GetFolder(folderPath).Files
Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
For Each itm In fileList
If Right(itm.Name, 4) = "xlsx" Then
Set wb = xlApp.Workbooks.Open(itm.Path)
fileName = fso.GetParentFolderName(itm.Path) & "\" & fso.GetBaseName(itm.Path)
If True Then 'if converting all sheets use For loop (Change True to False)
wb.Sheets(1).SaveAs fileName & ".txt", FileFormat:=xlTextWindows
Else
For Each ws In wb.Sheets
ws.SaveAs fileName & " - " & ws.Name & ".txt", FileFormat:=xlTextWindows
Next
Set ws = Nothing
End If
wb.Close: Set wb = Nothing
End If
Next
xlApp.Quit
End Sub
I have a string "sFile" that stores the name of workbook with extension.
I want to activate this workbook, stored in a string.
And then close it.
Code am using is:
Dim wbk as workbook
Set wbk = Workbooks(sFile)
wbk.Activate
wbk.close
But this is not working.Please help.
As mentioned in the comments, it only takes the name (not path) - this should do it for you:
Dim wbk as workbook
Set wbk = Workbooks(right(sFile,Instrrev(sFile,"\")+1))
wbk.Activate
wbk.close
You need to see if you succeed to Set wbk = Workbooks(sFile), it wil work only if the workbook is open.
If it doesn't succeed (wbk Is Nothing), then you need to open the workbook.
Code
Option Explicit
Sub SetWB_toOpenWorkbook()
Dim wbk As Workbook
Dim sFile As String
Dim FilePath As String
' just an example of my file name (clean with extension)
sFile = "SO_1.xlsm"
' set the Dektop path
FilePath = "C:\Users\" & Environ("USERNAME") & "\Desktop\"
On Error Resume Next
Set wbk = Workbooks(sFile)
On Error GoTo 0
If wbk Is Nothing Then ' if not open, then open the workbook
Set wbk = Workbooks.Open(FilePath & sFile)
End If
' just for my tests, put the workbook name in "A1" in "Sheet1"
wbk.Worksheets("Sheet1").Range("A1").Value = wbk.Name
wbk.Activate
wbk.Close True
End Sub
I have the code to copy all the sheets from one excel file to another, but I only have one sheet and when it copies it paste the original as sheet1 (2) in to the destination file.
I need the code to not create a new sheet just past sheet1 into sheet1 of the destination file
I tryed playing with it but could not get it
Thanks
Sub CopySheets()
Dim WB As Workbook
Dim SourceWB As Workbook
Dim WS As Worksheet
Dim ASheet As Worksheet
'Turns off screenupdating and events:
Application.ScreenUpdating = False
Application.EnableEvents = False
'Sets the variables:
Set WB = ActiveWorkbook
Set ASheet = ActiveSheet
Set SourceWB = Workbooks.Open(WB.Path & "\MyOtherWorkbook.xls") 'Modify to match
'Copies each sheet of the SourceWB to the end of original wb:
For Each WS In SourceWB.Worksheets
WS.Copy after:=WB.Sheets(WB.Sheets.Count)
Next WS
SourceWB.Close savechanges:=False
Set WS = Nothing
Set SourceWB = Nothing
WB.Activate
ASheet.Select
Set ASheet = Nothing
Set WB = Nothing
Application.EnableEvents = True
End Sub
Try below code.The below code can fail if the source workbook is in excel 2010 (xlsx) and destination workbook is in excel 2003 (xls). You may also have a look at RDBMerge Addin.
Sub CopySheets()
Dim SourceWB As Workbook, DestinWB As Workbook
Dim SourceST As Worksheet
Dim filePath As String
'Turns off screenupdating and events:
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'path refers to your LimeSurvey workbook
Set SourceWB = Workbooks.Open(ThisWorkbook.Path & "\LimeSurvey.xls")
'set source sheet
Set SourceST = SourceWB.Sheets("Management Suite Feedback - Tri")
SourceST.Copy
Set DestinWB = ActiveWorkbook
filePath = CreateFolder
DestinWB.SaveAs filePath
DestinWB.Close
Set DestinWB = Nothing
Set SourceST = Nothing
SourceWB.Close
Set SourceWB = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Function CreateFolder() As String
Dim fso As Object, MyFolder As String
Set fso = CreateObject("Scripting.FileSystemObject")
MyFolder = ThisWorkbook.Path & "\Reports"
If fso.FolderExists(MyFolder) = False Then
fso.CreateFolder (MyFolder)
End If
MyFolder = MyFolder & "\" & Format(Now(), "MMM_YYYY")
If fso.FolderExists(MyFolder) = False Then
fso.CreateFolder (MyFolder)
End If
CreateFolder = MyFolder & "\Data " & Format(Now(), "DD-MM-YY hh.mm.ss") & ".xls"
Set fso = Nothing
End Function
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