I have a Visual Basic script that converts excel files to text files. Let's say I have an excel file called example.xlsx; currently, the script saves it as example.xlsx.txt, which isn't what I want. I need it to save as: example.txt
Any ideas?
Option Explicit
Dim oFSO, myFolder
Dim xlTXT
myFolder="C:\..."
Set oFSO = CreateObject("Scripting.FileSystemObject")
xlTXT = 21 '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", xlTXT )
Exit For
Next
Set oWSH = Nothing
Call oWB.Close
Set oWB = Nothing
End If
Next
Call oExcel.Quit
Set oExcel = Nothing
End Sub
The FileSystemObject has a number of methods such as GetBaseName, GetFileName. So,
Call oWSH.SaveAs (myFolder & "\" & oFile.GetBaseName & ".txt", xlTXT)
(GetFileName would include the extension.)
But, as Harrison describes, you'll probably want to include the sheetname, or some number, as part of the filename.
You might consider using the worksheets' index as part of the file name, rather than having to invent numbers.
You are only saving the first sheet since you are exiting the foreach loop. To save all the sheets you can
Replace
For Each oWSH in oWB.Sheets
Call oWSH.SaveAs (oFile.Path & ".txt", xlTXT )
Exit For
Next
with
For Each oWSH in oWB.Sheets
Call oWSH.SaveAs (oWB.Name & "_" & oWSH.Name & ".txt", xlTXT )
Next
Note if you wanted to save just the first worksheet instead of using the Exit For after the first sheet you could use this.
Call oWB.Sheets(1).SaveAs (oWB.Name & ".txt", xlTXT )
Related
I'm a beginner at coding. So I would like to know how I could use nesting to code a macro (for VBA Word) that runs multiple other macros in all documents in a specified folder. I am trying to employ nesting by having the outer loop open all the documents in a folder (a user will input the location of the folder using InputBox), and within this loop, all the macros will be applied.
So far I know that this is what works perfectly (the code opens all documents in the specified folder);
Sub nestingMacro()
Dim currentFile As String
Dim location As String
location = InputBox("Location of folder")
If Right(location, 1) <> "\" Then location = location + "\"
currentFile = Dir(location & "*.doc*")
Do While (currentFile <> "")
Documents.Open FileName:=location & currentFile
currentFile = Dir()
Loop
End Sub
I tried adding the following;
Sub nestingMacro()
Dim currentFile As String
Dim location As String
location = InputBox("Location of folder")
If Right(location, 1) <> "\" Then location = location + "\"
currentFile = Dir(location & "*.doc*")
Do While (currentFile <> "")
Documents.Open FileName:=location & currentFile
currentFile = Dir()
If currentFile <> "" Then
'the name of the macros below
Call findReplaceStyle
Call countErrorsQuality
Call saveClose
End If
Loop
End Sub
Yes, it opens all documents in a folder, however, it runs the macros only on two of the documents then nothing happens to the others. How can I solve this?
Is there a better way to write the function IF, in order to run the macros on all documents using nesting?
Also is there a way to run the macros without actually calling their names?
Thank you!
You don't need if statement.
Sub nestingMacro()
Dim currentFile As String
Dim location As String
location = InputBox("Location of folder")
If Right(location, 1) <> "\" Then location = location + "\"
currentFile = Dir(location & "*.doc*")
Do While (currentFile <> "")
Documents.Open FileName:=location & currentFile
Call findReplaceStyle
Call countErrorsQuality
Call saveClose
currentFile = Dir()
Loop
End Sub
You don't need nesting for what you've described so far. If the code is only running on a few files in the folder, that's most likely because you're running the code from a document stored in the same folder and, as soon as it processes itself, it gets closed and that kills the macro. Try something along the lines of the following.
Sub Demo()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc as Document
strDocNm = ActiveDocument.Fullname
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc*", vbNormal)
While strFile <> ""
If strFolder & "\" & strFile <> strDocNm Then
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
Call findReplaceStyle
Call countErrorsQuality
Call saveClose
End If
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
A potential problem with your
Call findReplaceStyle
Call countErrorsQuality
lines is that you're not passing the document you've just opened as a parameter. If anything in those subs changes the activedocument, you could run into problems. It's good coding practice to pass the document you want to process as a parameter, as in:
Call findReplaceStyle(wdDoc)
Call countErrorsQuality(wdDoc)
Drawing on your previous thread on a related topic, to accept and use such a parameter, the latter sub might be coded along the lines of:
Sub countErrorsQuality(wdDoc As Document)
Dim Rng As Range
With wdDoc
Set Rng = .Range(0, 0)
If .SpellingErrors.Count > 0 Then
With Rng
.Text "REJECTED" & vbCr
.Font.Size = 14
.Font.ColorIndex = wdRed
.Font.Bold = True
End With
End If
End With
Set Rng = Nothing
End Sub
Note that nothing gets selected. This reduces screen flicker and makes the code run faster.
I likewise suspect you don't need your
Call saveClose
code and all you really need is:
wdDoc.Close SaveChanges:=True
I want to loop through a folder (G:/Proj) and find any subfolders named "SUMMARY LOG" and then print the Excel files, usually just one, within each of those folders.
This is the main folder (Proj) with all of the project folders within it
This is a screenshot of just one of the files I want to print out.
Each project has a SUMMARY LOG folder.
Here is the VBA code. It loops through every sub folder and prints out every Excel file in those folders not just the "SUMMARY LOG".
Sub LoopFolders()
Dim strFolder As String
Dim strSubFolder As String
Dim strFile As String
Dim colSubFolders As New Collection
Dim varItem As Variant
Dim wbk As Workbook
' Parent folder including trailing backslash
strFolder = "G:/Proj/"
' Loop through the subfolders and fill Collection object
strSubFolder = Dir(strFolder & "*", vbDirectory)
Do While Not strSubFolder = ""
Select Case strSubFolder
Case ".", ".."
' Current folder or parent folder - ignore
Case Else
' Add to collection
colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
End Select
' On to the next one
strSubFolder = Dir
Loop
' Loop through the collection
For Each varItem In colSubFolders
' Loop through Excel workbooks in subfolder
strFile = Dir(strFolder & varItem & "\*.xls*")
Do While strFile <> ""
' Open workbook
Set wbk = Workbooks.Open(Filename:=strFolder & _
varItem & "\" & strFile, AddToMRU:=False)
' Do something with the workbook
ActiveSheet.PrintOut
' Close it
wbk.Close SaveChanges:=False
strFile = Dir
Loop
Next varItem
End Sub
This is how I changed your code (please note that you should set your "objects" to nothing at the end of your code).
Note that I just used a simple "If" statement with the "InStr" function to try and catch the buzzwords associated with your excel workbooks. Here is what my simulated folder looked like:
Simulated Folder with File Names
Sub LoopFolders()
Dim strFolder As String
Dim strSubFolder As String
Dim strFile As String
Dim colSubFolders As New Collection
Dim varItem As Variant
Dim wbk As Workbook
' Parent folder including trailing backslash
strFolder = "C:\Users\anm2mip\Desktop\Exp\"
' Loop through the subfolders and fill Collection object
strSubFolder = Dir(strFolder & "*", vbDirectory)
Do While Not strSubFolder = ""
Select Case strSubFolder
Case ".", ".."
' Current folder or parent folder - ignore
Case Else
' Add to collection
colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
End Select
' On to the next one
strSubFolder = Dir
Loop
' Loop through the collection
For Each varItem In colSubFolders
' Loop through Excel workbooks in subfolder
strFile = Dir(strFolder & varItem & "\*.xls*") 'never mind the .xlsx, I forgot that the * symbol is wildcard.
Do While strFile <> ""
If InStr(strFile, "Summary") And InStr(strFile, "Log") Then
' Open workbook
Set wbk = Workbooks.Open(FileName:=strFolder & _
varItem & "\" & strFile, AddToMRU:=False)
' Do something with the workbook
MsgBox strFile
' ActiveSheet.PrintOut
' Close it
wbk.Close SaveChanges:=False
End If
strFile = Dir
Loop
Next varItem
Set colSubFolders = Nothing
Set varItem = Nothing
Set wbk = Nothing
End Sub
UPDATE
Test Folder Structure
Note that I threw a couple different excel file types and a word document in there as well, and my code below filters out all except the excel file types that I've specified.
I used this answer as a reference: Recursive drill down into folders example. Thank you user #Cor_Blimey for the easy-to-use post.
Sub LoopFolders()
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Dim colFiles As New Collection
Dim wbk As Workbook
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder("C:\Users\anm2mip\Desktop\Exp\")
' Parent folder including trailing backslash
'strFolder = "C:\Users\anm2mip\Desktop\Exp\"
Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1 'dequeue
For Each oSubfolder In oFolder.SubFolders
queue.Add oSubfolder
Next oSubfolder
'Filter subfolders here
If InStr(oFolder.Name, "Summary") And InStr(oFolder.Name, "Log") Then
For Each oFile In oFolder.Files
'You can filter files here with an if...then statement
If oFile.Type = "Microsoft Excel Worksheet" Or _
oFile.Type = "Microsoft Excel 97-2003 Worksheet" Or _
oFile.Type = "Microsoft Excel Macro-Enabled Worksheet" Then
colFiles.Add Item:=oFile, Key:=oFile.Name
Next oFile
End If
Loop
MsgBox "Number of files held in Summary Log folders is: " & colFiles.Count
For Each oFile In colFiles
Set wbk = Workbooks.Open(FileName:=oFile.Path, AddtoMRU:=False)
MsgBox oFile.Name
'Do your printing operation here.
wbk.Close SaveChanges:=False
Next oFile
Set fso = Nothing
Set oFolder = Nothing
Set oSubfolder = Nothing
Set oFile = Nothing
Set queue = Nothing
Set wbk = Nothing
End Sub
There is an unzipping code I'd like to adjust 4 my needs.
Sub Unzip()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefinePath As String
' Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", MultiSelect:=False)
Fname = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl.zip"
If Fname = False Then
'Do nothing
Else
'Destination folder
DefinePath = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst\" ' Change to your path / variable
If Right(DefinePath, 1) <> "\" Then
DefinePath = DefinePath & "\"
End If
FileNameFolder = DefinePath
' Delete all the files in the folder DefPath first if you want.
' On Error Resume Next
' Kill DefPath & "*.*"
' On Error GoTo 0
'Extract the files into the Destination folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
' MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub
Somewhere here:
`Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere`
a dialog box appears asking me if I want to overwrite the file that have the same names - and Yes I do want to overwrite them, but without answering the dialog box - I would like to hardcode it into the code, please.
I've found this page https://msdn.microsoft.com/en-us/library/windows/desktop/bb787866(v=vs.85).aspx but I just don't know how to add this parameter #16 which is "Respond with "Yes to All" for any dialog box that is displayed."
Can U help me with that?
And the last thing:
can You explain oApp.Namespace(Fname).items line for me.
I've really tried to guess it myself, but I thing I'm to short 4 this.
the code that results in no questions or no prompting of any kind is as follows:
Option Explicit
Sub Bossa_Unzip()
Dim FSO As Object
Dim oApp As Object ' oApp is the object which has the methods you're using in your code to unzip the zip file:
'you need to create that object before you can use it.
Dim Fname As Variant
Dim FileNameFolder As Variant ' previously Dim FileNameFolder As Variant
Dim DefinePath As String
' Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", MultiSelect:=False)
Fname = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl.zip"
If Fname = False Then
'Do nothing
Else
'Destination folder
DefinePath = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst\" ' Change to your path / variable
If Right(DefinePath, 1) <> "\" Then
DefinePath = DefinePath & "\"
End If
FileNameFolder = DefinePath
' Delete all the files in the folder DefPath first if you want.
' On Error Resume Next
' Kill DefPath & "*.*"
' On Error GoTo 0
'Extract the files into the Destination folder
Set oApp = CreateObject("Shell.Application") ' you need to create oApp object before you can use it.
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items, 16
'MsgBox "You'll find the files here: " & DefinePath
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub
Of course this site helped me a lot - its CpyHere explanation site.
One thing I don't understand is why Fname and FileNumberFolder need to be declared as variant. In my opinion, they should be declared as String. Just look at this screenshot.
But when I declare them that way, the code gives me error.
Just look here, when the variables already have their values (first picture). The FileNameVariable and DefinePath variable have the exact same value, and it looks like a string 4 me. How is that necessary, that I need to declare another variable - FileNameVariable in that case (in 17th line) with the same value, but variant type.
please explain that to me, someone.
I have a two codes. I would like the second code to perform the first code on all files in a directory. The first code works like a charm and does exactly what I need it to, this is that:
Sub STATTRANSFER()
' Transfers all STATS lines
Application.ScreenUpdating = False
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = "STATS"
Set f = Sheets(1)
Set e = Sheets("Stats")
Dim d
Dim j
Dim k
d = 1
j = 1
k = 1
Do Until IsEmpty(f.Range("A" & j))
If f.Range("A" & j) = "STATS" Then
e.Rows(d).Value = f.Rows(j).Value
d = d + 1
f.Rows(j).Delete
Else
j = j + 1
End If
Loop
Application.ScreenUpdating = True
End Sub
The second code looks like this:
Public Sub DataProcess()
Dim folderPath
Dim filename
Dim newfilename
Dim SavePath
Dim mySubFolder As Object
Dim mainFolder As Object
Dim WB As Workbook
Dim OrigWB As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim name1 As String
Dim name2 As String
Set OrigWB = ThisWorkbook
Set objFSO = CreateObject("Scripting.FileSystemObject")
folderPath = ActiveWorkbook.Path
Set mainFolder = objFSO.GetFolder(folderPath)
filename = Dir(folderPath & "*.csv")
Do While Len(filename) > 0
Set WB = Workbooks.Open(folderPath & filename)
Call STATTRANSFER
ActiveWorkbook.Close SaveChanges:=True
filename = Dir
Loop
For Each mySubFolder In mainFolder.SubFolders
filename = Dir(mySubFolder.Path & "\*.csv*")
Do While Len(filename) > 0
Set WB = Workbooks.Open(mySubFolder.Path & "\" & filename)
Call STATTRANSFER
ActiveWorkbook.Close SaveChanges:=True
filename = Dir
Loop
Next
End Sub
The second code does successfully loop through all of the folders and documents I want it to, however it performs my first code incorrectly. When I perform the first code on a sheet alone, it creates a new sheet called STATS then takes all lines from the first sheet that has the word STATS in column A and copies them to the new sheet, it then deletes the STATS lines out of the first sheet.
When I run it with the second code that goes through all the folders it doesn't work the same. I can see it create the sheet called STATS on my screen but then when it finishes and I open up on of the documents all the lines that have STATS in column A are on the first sheet, the STATS sheet is no longer there, and all the data that didn't have STATS in column A is gone. So I'm not sure what the problem is.
Keep your first sub as it is, replace your second sub with this:
Sub MM()
Dim file As Variant
Dim files As Variant
Dim WB As Excel.Workbook
files = Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & ActiveWorkbook.Path & "\*.csv"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
For Each file In files
Set WB = Workbooks.Open(file)
STATTRANSFER
WB.Close True
Set WB = Nothing
Next
End Sub
just as an remark: your code only runs thru the first level of sub folders. If you want to go thru all sub level folders, you have to use a recursive method like:
Private Sub test()
readFileSystem ("C:\Temp\")
End Sub
Private Sub readFileSystem(ByVal pFolder As String)
Dim oFSO As Object
Dim oFolder As Object
' create FSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
' get start folder
Set oFolder = oFSO.getFolder(pFolder)
' list folder content
listFolderContent oFolder
' destroy FSO
Set oFolder = Nothing
Set oFSO = Nothing
End Sub
Private Sub listFolderContent(ByVal pFolder As Object)
Dim oFile As Object
Dim oFolder As Object
' go thru all sub folders
For Each oFolder In pFolder.SubFolders
Debug.Print oFolder.Path
' do the recursion to list sub folder content
listFolderContent oFolder
Next
' list all files in that directory
For Each oFile In pFolder.Files
Debug.Print oFile.Path
Next
' destroy all objects
Set pFolder = Nothing
Set oFile = Nothing
Set oFolder = Nothing
End Sub
this is just an example and you have to call your first procedure of course still correct. So I would suggest to add a parameter to the first procedure where you can pass the workbook.
and BTW: always delcare your variables with datatype. Dim j will declare a VARIANT variable and not a Interger as you might want to have.
You see all STATS in the first sheet because you added an extra sheet to a CSV file and saved it. By definition, CSV file only saves and shows 1 sheet.
This modification to your code could solve your problem, as it calls itself to go through subfolders.
Try it.
Include your STATTRANSFER sub.
Public Sub DataProcess()
thisPath = ThisWorkbook.Path
process_folders (thisPath)
End Sub
Sub process_folders(thisPath)
Dim folderPath
Dim filename
Dim newfilename
Dim SavePath
Dim mySubFolder As Object
Dim mainFolder As Object
Dim WB As Workbook
Dim OrigWB As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim name1 As String
Dim name2 As String
Set OrigWB = ThisWorkbook
Set objFSO = CreateObject("Scripting.FileSystemObject")
folderPath = ActiveWorkbook.Path
Set mainFolder = objFSO.GetFolder(folderPath)
folderPath = ActiveWorkbook.Path
filename = Dir(folderPath & "\*.csv")
Do While Len(filename) > 0
Set WB = Workbooks.Open(folderPath & "\" & filename)
Call STATTRANSFER
'save file as Excel file !!!
ActiveWorkbook.SaveAs _
filename:=(folderPath & "\" & filename), _
FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
ActiveWorkbook.Close (False)
filename = Dir
Loop
'now with each subfolder
For Each subfolder In mainFolder.SubFolders
process_folders (subfolder)
Next
End Sub
The problem was that you can only save a .csv with one sheet on it. Now the code looks like this.
Sub NewDataProcess()
Dim file As Variant
Dim files As Variant
Dim wb As Excel.Workbook
files = Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & ActiveWorkbook.Path & "\*.csv"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
For Each file In files
Set wb = Workbooks.Open(file)
Call STATTRANSFER(wb)
newfilename = Replace(file, ".csv", ".xlsm")
wb.SaveAs filename:=newfilename, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
wb.Close SaveChanges:=False
Set wb = Nothing
Next
End Sub
Now I need a way to delete the old files if someone can help with that. I dont want the CSV file at all anymore
I need to find out the number of rows in each excel sheets under a folder .Google search shows that the below script works..but having very less knowledge on vb ,i could not resolve it.The script containe ''Wscript object.I think this works with out this object as well
The thing is under "c:\temp", i have 100 excel sheets(.xls). Need to find out number of rows in each file. Help needed from vb experts
Dim objFSO, strFolder, objFolder, objFile, objExcel, objSheet, objRange, objRows As Object
Dim strExtension As String
Dim V_FilePath As String = " "
' Specify folder.
strFolder = "c:\\temp" -----
objExcel = CreateObject("Excel.Application")
' Enumerate files in the folder.
objFSO = CreateObject("Scripting.FileSystemObject")
objFolder = objFSO.GetFolder(strFolder)
For Each objFile In objFolder.Files
' Select only Excel spreadsheet file.
strExtension = objFSO.GetExtensionName(objFile.Path)
If (strExtension = "xls") Or (strExtension = "xlsx") Then
' Open each spreadsheet and count the number of rows.
objExcel.Workbooks.Open(objFile.Path)
objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objRange = objSheet.UsedRange
objRows = objRange.Rows
' Display spreadsheet name and the number of rows.
MsgBox(objExcel.ActiveWorkbook + CStr(objRows.Count))
''Wscript.Echo(objFile.Path & " (" & objRows.Count & ")")
' Close the spreadsheet.
objExcel.ActiveWorkbook.Close()
End If
Next
' Clean up.
objExcel.Application.Quit()
Dts.TaskResult = ScriptResults.Success
End Sub
Make sure you're declaring the sub routine at the top with "Sub _()". Also, there are a few things that I believe are syntactically incorrect about this one. Try this instead:
Sub blah()
Dim objFSO, strFolder, objFolder, objFile, objExcel, objSheet, objRange, objRows As Object
Dim strExtension As String
Dim V_FilePath As String
V_FilePath = " "
' Specify folder.
strFolder = "c:\\temp"
objExcel = CreateObject("Excel.Application")
' Enumerate files in the folder.
objFSO = CreateObject("Scripting.FileSystemObject")
objFolder = objFSO.GetFolder(strFolder)
For Each objFile In objFolder.Files
' Select only Excel spreadsheet file.
strExtension = objFSO.GetExtensionName(objFile.Path)
If (strExtension = "xls") Or (strExtension = "xlsx") Then
' Open each spreadsheet and count the number of rows.
objExcel.Workbooks.Open (objFile.Path)
objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objRange = objSheet.UsedRange
objRows = objRange.Rows
' Display spreadsheet name and the number of rows.
MsgBox (objExcel.ActiveWorkbook + CStr(objRows.Count))
''Wscript.Echo(objFile.Path & " (" & objRows.Count & ")")
' Close the spreadsheet.
objExcel.ActiveWorkbook.Close
End If
Next
' Clean up.
objExcel.Application.Quit
Dts.TaskResult = ScriptResults.Success
End Sub
If you're doing this in VBA in an Excel Macro, perhaps this will work a bit better:
Sub LoopThroughFiles()
Dim strFile As String
Dim strPath As String
Dim colFiles As New Collection
Dim i As Integer
Dim rowCount As Integer
strPath = "C:\Users\[windows_username]\Documents\" 'Your path here
strFile = Dir(strPath)
While strFile <> ""
colFiles.Add strFile
strFile = Dir
Wend
'List filenames in Column A of the active sheet
If colFiles.Count > 0 Then
For i = 1 To colFiles.Count
ActiveSheet.Cells(i, 1).Value = colFiles(i)
Workbooks.Open strPath & colFiles(i)
rowCount = ActiveSheet.UsedRange.Rows.Count
Workbooks(colFiles(i)).Close
'Workbooks.Close
'ThisWorkbook.Close
ActiveSheet.Cells(i, 2).Value = rowCount
Next i
End If
End Sub
This would work
MsgBox(objFile.name + CStr(objRows.Count))