I'm trying to write code for creating the map of excel workooks network (like one file with links to seven other files, which in turn have their own links to maybe different files, etc.). Since I don't know a priori the set of all files in the network, I want to do this by recursion. I've written this piece of code:
Sub recLink(strPath As String)
Dim WB As Workbook
Set WB = Workbooks.Open(strPath , False, True)
If Not IsEmpty(WB.LinkSources(xlExcelLinks)) Then
For Each LNK In WB.LinkSources(xlExcelLinks)
Debug.Print LNK
Call recLink(Str(LNK))
Next LNK
Else
End If
WB.Close (False)
End Sub
and the problem is the excel app shuts down when trying to open a workbook in the second iteration. That is true even for small and simple files created for the purpose of testing.
Can you please help me with making this work? What am I missing here?
The cause
The issue is on the Str(LNK) from "Call recLink(Str(LNK))".
The solution
Create a string variable and set LNK to this var, then you can call the function using the string variable. This will work.
Dim strLink as String
.
.
strLink = LNK
Call recLink( strLink )
.
.
How I found
I only discovered because I was trying to put all links in array first, and the same issue occoured when VBA was simply going to define the array with LNK. So I figure out that the issue could not be the recursive call and the only thing that was different was the STR () function.
arrLink(x) = Str(LNK)
My sugestion
This code keep all the windows of Excel hide, the presentation prettier and the execution faster.
Function recLink(strPath As String)
Dim objMaster As Object
Dim wbkMaster As Workbook
Dim strLink As String
Set objMaster = CreateObject("Excel.Application")
With objMaster
.Visible = False
Set wbkMaster = .Workbooks.Open(strPath)
If Not IsEmpty(wbkMaster.LinkSources(xlExcelLinks)) Then
For Each LNK In wbkMaster.LinkSources(xlExcelLinks)
strLink = LNK
Debug.Print strLink
Call recLink(strLink)
Next LNK
Else
End If
End With
wbkMaster.Close (False)
Set objMaster = Nothing
Set wbkMaster = Nothing
End Function
Conclusion
Test both codes and choose what is the best for you.
Regards
Have a nice weekend.
Related
I'm currently writing a macro that will allow you to select a folder, set bounds, and then loop through some numbers to read in all of a certain file type. (Excel in this instance.)
You can see that right here
Dim StringP1 As String
Dim iterator As Integer
Dim StringP2 As String
Dim i As Integer
Dim final As Integer
'number of files
final = 5
'main folder
StringP1 = " FOLDER NAME "
StringP2 = ".xls"
i = 1
While i < final
iterator = 1
FileName = StringP1 & iterator & StringP2
Call attempt1(FileName)
Call attempt2(FileName)
i = (i + 1)
iterator = (iterator + 1)
Wend
when it loads into my subs it uses this code
Sub attempt1(FN As String)
Dim Excel As New Excel.Application
Dim FileName As String
Set XL = CreateObject("Excel.Application")
Set MyRec = CurrentDb.OpenRecordset("Infor")
Excel.Workbooks.Open (FN)
Then it goes through some code, and eventually ends up exiting the subroutine.
Everything I've tried seems to fail.
I've been messing with this for a few hours, using various things I've found from Stackoverflow and other VBA sites, but nothing seems to work.
I've tried using
excel.workbooks.close savechanges:=false
workbook.close
workbooks.close
.
.
.
I'm curious if anyone knows a good way to exit all of these EXCEL.EXE that open?
If I understand correctly you are trying to close all workbooks (Excel files).
Proper way to close single workbook by its name:
XL.Workbooks("filename.xls").Close Savechanges:=False
If you have many workbooks to close you may use a cycle like this:
Public Sub WorkWithExcel()
Dim XL As New Excel.Application, WB As Excel.Workbook
' Open Excel file:
XL.Workbooks.Open ("my_file.xls")
' Open another Excel file
XL.Workbooks.Open ("another my file.xls")
' do some work with this files
' ...
' For every file in our application:
For Each WB In XL.Workbooks
' Close file without saving changes:
WB.Close savechanges:=False
Next WB
' Close Excel applicatioin:
XL.Quit
' Clear object:
Set XL = Nothing
End Sub
I wondered if anyone can shed some light on why opening a Word document would take a few seconds from Excel? The code below quickly finds/opens a specific subfolder using InStr i.e. debug.print of the subfolder name is immediate, however opening the specific Word doc takes about 4 seconds. I tried testing a similar procedure in Word itself it opened the document almost immediately. I'm still learning VBA and I'm not sure what the reason would be other than its something to do with the last bit re strFile
Any suggestions would be appreciated.
Sub LoopSubfolderAndFiles()
Dim fso As Object
Dim folder As Object
Dim subfolder1 As Object
Dim strTextFind1 As String
Dim strFileFound As String
Dim CurrFile As Object
Dim myFile As Object
Dim strFile As String
Dim strExtension As String
Dim wordApp As New Word.Application
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("Enter FILEPATH name..........")
Set subfolder1 = folder.subfolders
strTextFind1 = "useful"
strFileFound = "test"
strExtension = ".doc"
For Each subfolder1 In subfolder1
If InStr(1, subfolder1.Name, strTextFind1, vbTextCompare) > 0 Then
Set CurrFile = fso.GetFolder(subfolder1)
Debug.Print subfolder1.Name
Exit For
End If
Next
For Each CurrFile In CurrFile.Files
If InStr(1, CurrFile.Name, strFileFound, vbTextCompare) > 0 Then
Set myFile = fso.GetFile(CurrFile)
strFile = myFile.Path
wordApp.Visible = True
wordApp.Documents.Open (strFile)
Debug.Print strFile
End If
Next
Set fso = Nothing
Set folder = Nothing
Set subfolder1 = Nothing
Set CurrFile = Nothing
End Sub
There is nothing substantive wrong with your code. Word is slow.
The difference could be inprocess vs outofprocess. Out of Process calls are made using the RPC networking remote call procedure. Hidden windows are created so messages can be received. It's all very complicated so out of process calls work under all circumstances. In Process Calls are just a machine code jump instruction. Several clock cycles vs tens of thousands or more.
There are some minor issues.
These lines are pointless. This is handled at the end of each line for implicit variables and every end function etc for explicit variables. See Declaring Variables Memory Leaks
Set fso = Nothing
Set folder = Nothing
Set subfolder1 = Nothing
Set CurrFile = Nothing
If you want to do this indirection then they need to be const. The compiler will put them into the line where used as literals. Use variables only where needed.
strTextFind1 = "useful"
strFileFound = "test"
strExtension = ".doc"
So
const strTextFind1 = "useful"
const strFileFound = "test"
const strExtension = ".doc"
You are late binding to FSO. Use early binding as you do for Word. See Pointers needed for speeding up nested loop macro in VBA. Then instead of Dim folder As Object dim it as you do word.
Looking at your code, it's not just opening the document, it's also starting a new instance of the Word application*. So there are a number of factors that are taking time:
Starting Word. Have you ever timed how long it takes Word to start when you click the icon? First, the application itself needs to load. Then, there may be any number of add-ins loading, which will take time.
When an outside application "automates" another application there is a time "hit" for the "cross-barrier" communication. VBA within an Office application is usually quite fast; the same commands run from a different application will be (noticeably) slower.
'* You should never declare and instantiate an application in the same line in VBA. You should change your code to:
Dim wordApp as Word.Application
Set wordApp = New Word.Application
How to import a Sheet from an external Workbook AND use the Filename (WITHOUT the .datatype at the end) as the new Worksheet name?
The part with WITHOUT the .datatype at the end I meant because I could split the filename from the file path with UBound, but when I try to do that with the filename and the filetype at the end, it doesn't work and gives me an error. Perhaps i dont understand ubound
well enough.
I found this Sub somewhere here on the forum.
But I don't want to import any sheet except the sheet which has the same name as the file itself. So I am not even sure if you need to specify the sheet name.
So I have this Excel file with VBA macros. And the Sheet is called Blank (Since I can't have an excel file without a sheet inside it) and
I have a Userform button where I browse for the file first, and the sheet there should be imported to my Excel File and delete the Blank sheet and import the new EXTERNAL sheet.
Also, it should import ANY Sheet from the file path. Because the names will always be different.
And also, how do I import the data as csv?
I am googling but I don't see what exactly causes it to be imported as csv at other peoples solutions.
Sub ImportSheet()
Dim sImportFile As String, sFile As String
Dim sThisBk As Workbook, wbBk As Workbook
Dim vfilename As Variant
Dim wsSht As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sThisBk = ActiveWorkbook
sImportFile = Application.GetOpenFilename( _
FileFilter:="Comma Separated Value, *.csv", Title:="Open Workbook")
If sImportFile = "False" Then
MsgBox "No File Selected!"
Exit Sub
Else
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
Application.Workbooks.Open Filename:=sImportFile
Set wbBk = Workbooks(sFile)
With wbBk
If SheetExists("GaebTesten.g42_2") Then
Set wsSht = .Sheets("GaebTesten.g42_2")
wsSht.Copy Before:=sThisBk.Sheets("Start")
Else
MsgBox "There is no sheet with name :US in:" & vbCr & .Name
End If
wbBk.Close SaveChanges:=False
End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Function SheetExists(sWSName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True
End Function
this is my second post here on stack overflow, and my first question was very dumb, and when I asked my first question, it was my 2nd hour with vba.
I think I am at about 30 hours now and I've learned a lot.
Question: I am doing this Excel Macro in VBA with userform too now. But mostly I google how to do what and I try to implement it WHILE understanding it, I don't just copy and paste code. Often I just do line by line and test it out.
BUT... how do you guys remember all that?
If I had to program the same thing again right now, I won't know how to, because I know how a syntax works, but I wouldn't know which syntax and stuff to actually use to achieve the desired effect...
Does it come from repeating the same things = experience?
Or how do you acquire the abilities to code without googling almost every single thing? When watching youtubers live streaming how they code something, they never look it up on the internet....
Let me present you a different way than pure string manipulation:
Set a new reference to Microsoft Scripting Runtime. This will enable the Scripting namespace. With it you can do things like the following:
sImportFile = "C:\StackFolder\PrintMyName.xlsx"
With New Scripting.FileSystemObject
Debug.Print .GetBaseName(sImportFile)
' Outputs "PrintMyName"
Debug.Print .GetExtensionName(sImportFile)
' Outputs "xlsx"
Debug.Print .GetFileName(sImportFile)
' Outputs "PrintMyName.xlsx"
Debug.Print .GetDriveName(sImportFile)
' Outputs "C:"
Debug.Print .GetParentFolderName(sImportFile)
' Outputs "C:\StackFolder"
End With
You can build a little helper function to give you the part of the file name you need:
Public Function GetFilenameWithoutExtension(ByVal filename as String) as String
With New Scripting.FileSystemObject
GetFilenameWithoutExtension = .GetBaseName(filename)
End With
End Function
and call it: sFile = GetFilenameWithoutExtension(sImportFile)
Regarding the interesting use of UBound in your subroutine, you could even get the filename (without extension) that way - assuming it doesn't contain additional dots:
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
SplitName = Split(sFile, ".")
FilenameWithoutExtension = SplitName(UBound(SplitName)-1)
Extension = SplitName(UBound(SplitName))
These are, however, purely academical thoughts and I wouldn't recommend doing it this way.
Here are two ways to extract the workbook name without the file extension. Here I am removing the extension .xlsx. If the extension is constant, you can just hard code it. If not, you can use wildcards also
MsgBox Left(wbBk.Name, Len(ThisWorkbook.Name) - 5)
MsgBox Replace(wbBk.Name, ".xlsx", "")
You can refer to the sheet with the same name as the workbook by using something like
Sheets(Left(wbBk.Name, Len(ThisWorkbook.Name) - 5).Copy
Sheets(Replace(wbBk.Name, ".xlsx", "").Copy
You can use InstrRev. It is efficient as starts from the end of the string which is where the extension is located.
Left$(wbBk.Name, InStrRev((wbBk.Name, ".") - 1)
We have been using VBA code for years with Excel 2003. I have about 70 files that I pull information from and compile it into one spreadsheet. This time, it only recognizes 3 of the 70. I do not get any errors. I noticed that all 3 recognized are the old version ".xls." and all not being recognized are the ".xlsx". The portion of the code that I think is causing the problem is below. Can anyone help?
Public currApp As String
Public i As String
Public recordC As String
Public excelI As Integer
Public intFileHandle As Integer
Public strRETP As String
Public errFile As String
Public Function loopFiles(ByVal sFolder As String, ByVal noI As Integer)
'This function will loop through all files in the selected folder
'to make sure that they are all of excel type
Dim FOLDER, files, file, FSO As Object
excelI = noI
'MsgBox excelI
i = 0
'Dim writeFile As Object
'writeFile = My.Computer.FileSystem.WriteAllText("D:\Test\test.txt", "sdgdfgds", False)
Dim cnn As Connection
Set cnn = New ADODB.Connection
currApp = ActiveWorkbook.path
errFile = currApp & "\errorFile.txt"
If emptyFile.FileExists(errFile) Then
Kill errFile
Else
'Do Nothing
End If
'cnn.Open "DSN=AUTOLIV"
'cnn.Open "D:\Work\Projects\Autoliv\Tax workshop\Tax Schedules\sox_questionnaire.mdb"
cnn.Open ("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & currApp & "\tax_questionnaire.mdb")
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set FSO = CreateObject("Scripting.FileSystemObject")
'Upon each found excel file it will make a call to saveFiles.
If sFolder <> "" Then
Set FOLDER = FSO.getfolder(sFolder)
Set files = FOLDER.files
For Each file In files
'ONLY WORK WITH EXCEL FILES
If file.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open fileName:=file.path
xlsx is a "macro-free" workbook. To use VBA in the new file format, the file must be saved as an xlsm file.
EDIT: I read the question too hastily. If you want to identify excel files from the FSO object, use file.Type LIKE "Microsoft Excel *" or similar. Or, check the file's extension against ".xls*"
EDIT
The whole concept of identifying the file type by looking at the file name is fundamentally flawed. It's too easily broken by changes to file extensions and/or the "type" texts associated with those descriptions. It's easily broken by, say, an image file named "file.xls". I would just try opening the file with Workbooks.Open and catch the error. I'd probably put this logic in a separate function:
Function OpenWorkbook(strPath As String) As Workbook
On Error GoTo ErrorLabel
Set OpenWorkbook = Workbooks.Open(strPath)
ExitLabel:
Exit Function
ErrorLabel:
If Err.Number = 1004 Then
Resume ExitLabel
Else
'other error handling code here
Resume ExitLabel
End If
End Function
Then you can consume the function like this:
Dim w As Workbook
Set w = OpenWorkbook(file.Path)
If Not (w Is Nothing) Then
'...
The problem you're having has to do with this line:
If file.Type = "Microsoft Excel Worksheet" Then
Try adding and replacing it with this:
// add these lines just AFTER the line 'For Each file In files'
IsXLFile = False
FilePath = file.path
FilePath2 = Right(FilePath, 5)
FilePath3 = Mid(FilePath2, InStr(1, FilePath2, ".") + 1)
If UCase(Left(FilePath3, 2)) = "XL" Then IsXLFile = True
// replace faulty line with this line
If IsXLFile = True Then
Let me know how it works. Yes, it'd be possible to compress the statements that start with FilePath into one expression but I left it like that for clarity. Vote and accept the answer if good and follow-up if not.
Have a nice day.
I have about 50 or so Excel workbooks that I need to pull data from. I need to take data from specific cells, specific worksheets and compile into one dataset (preferably into another excel workbook).
I am looking for some VBA so that I can compile the results into the workbook I am using to run the code.
So, one of the xls or xlsx files I need to pull the data from, worksheet("DataSource"), I need to evaluate cell(D4), and if its not null, then pull data from cell(F4), and put into a new row into the compiled data set. Looping through all the Excel files in that folder as mentioned above.
And if possible, I would like the first data field in the first column the name of the file the data is being pulled from in the resulting dataset.
Can someone help me with this? I am looking for VBA because I am more familiar with that, but also interested in VBScript (as I am trying to get into that and learn the differences).
First start with this google query and click the first link that comes up, which takes you to an article showing how to iterate through a group of Excel files in a folder.
Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "C:\MyDocuments\TestResults"
.FileType = msoFileTypeExcelWorkbooks
'Optional filter with wildcard
'.Filename = "Book*.xls"
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
'DO YOUR CODE HERE
wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
To get the name of the workbook, you'll want to adapt the code at "DO YOUR CODE HERE" to include wbResults.Name. If it's the filename you want, use wbResults.FullName, which returns the name of the workbook including its path on disk as a string.
A search for a VBScript variation on the same thing yields a number of results that are useful, including this script:
strPath = "C:\PATH_TO_YOUR_FOLDER"
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder (strPath)
For Each objFile In objFolder.Files
If objFso.GetExtensionName (objFile.Path) = "xls" Then
Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)
' Include your code to work with the Excel object here
objWorkbook.Close True 'Save changes
End If
Next
objExcel.Quit
I would do it in VBScript or even, VB.NET or Powershell if you feel so inclined.
Using VB.NET, you can access Excel spreadsheets as if they were databases, via the OLEDB provider. The code to select a range of values might look like this :
Try
Dim MyConnection As System.Data.OleDb.OleDbConnection
Dim DtSet As System.Data.DataSet
Dim MyCommand As System.Data.OleDb.OleDbDataAdapter
MyConnection = New System.Data.OleDb.OleDbConnection _
("provider=Microsoft.Jet.OLEDB.4.0;" _
" Data Source='testfile.xls'; " _
"Extended Properties=Excel 8.0;")
MyCommand = New System.Data.OleDb.OleDbDataAdapter _
("select * from [Sheet1$]", MyConnection)
MyCommand.TableMappings.Add("Table", "TestTable")
DtSet = New System.Data.DataSet
MyCommand.Fill(DtSet)
MyConnection.Close()
Catch ex As Exception
MsgBox(ex.ToString)
End Try
Once you get the data you can elaborate on it, then insert the result into another Excel spreadsheet, using the same API.
Getting the list of files is easy in .NET with a call to System.IO.Directory.GetFiles(); just specify the "*.xls" wildcard. Once you have the list, just use a for loop to iterate through it, opening each file in turn, then doing the query on that file, and so on.
If you use VBScript, then the preferred way to get the list of Excel files is to use the Scripting.FileSystemObject, specifically the GetFolder method. It works basically the same way but the syntax is slightly different.
If it's VBScript or VB.NET it will probably run outside of Excel itself. You'd run it by double-clicking or from a batch file or something like that. The advantage to using VB.NET is you could put up a graphical form for interaction - it could show a progress bar, tracking how many files you've gone through, status updates, that kind of thing.
Whenever you are accessing that many Excel files in succession, you can generally get better performance using ADODB rather than Excel's automation object.
I agree with using that accessing the Excel object is not the quickest and if the workbooks and sheets that you're trying to retrieve data from are all consistent (i.e have the same column names, etc... or at least the column names you're looking for) it would be better to use ODBC. This does have some issues and if you can't get around them or need to actually do something more complex based on the contents then there may be no way around it. If that's the case then I would suggest creating one Excel object and then opening and closing the files as needed to try to increase the efficiency.
It could be done with the following code
Sub LoopThroughFiles()
Dim StrFile As String
StrFile = Dir("V:\XX\XXX\*.xlsx")
Do While Len(StrFile) > 0
Debug.Print StrFile
Set wbResults = Workbooks.Open("V:\XX\XXX\" & StrFile)
'DO YOUR CODE HERE
wbResults.Close SaveChanges:=True
StrFile = Dir
Loop
End Sub