So I have a "master" excel file that I need to populate with data from excel files in a directory. I just need to access each file and copy one line from the second sheet in each workbook and paste that into my master file without opening the excel files.
I'm not an expert at this but I can handle some intermediate macros. The most important thing I need is to be able to access each file one by one without opening them. I really need this so any help is appreciated! Thanks!
Edit...
So I've been trying to use the dir function to run through the directory with a loop, but I don't know how to move on from the first file. I saw this on a site, but for me the loop won't stop and it only accesses the first file in the directory.
Folder = "\\Drcs8570168\shasad\Test"
wbname = Dir(Folder & "\" & "*.xls")
Do While wbname <> ""
i = i + 1
ReDim Preserve wblist(1 To i)
wblist(i) = wbname
wbname = Dir(FolderName & "\" & "*.xls")
How does wbname move down the list of files?
You dont have to open the files (ADO may be an option, as is creating links with code, or using ExecuteExcel4Macro) but typically opening files with code is the most flexible and easiest approach.
Copy a range from a closed workbook (ADO)
ExecuteExcel4Macro
Links method
But why don't you want to open the files - is this really a hard constraint?
My code in Macro to loop through all sheets that are placed between two named sheets and copy their data to a consolidated file pulls all data from all sheets in each workbook in a folder together (by opening the files in the background).
It could easily be tailored to just row X of sheet 2 if you are happy with this process
I just want to point out: You don't strictly need VBA to get values from a closed workbook. You can use a formula such as:
='C:\MyPath\[MyBook.xls]Sheet1'!$A$3
You can implement this approach in VBA as well:
Dim rngDestinationCell As Range
Dim rngSourceCell As Range
Dim xlsPath As String
Dim xlsFilename As String
Dim sourceSheetName As String
Set rngDestinationCell = Cells(3,1) ' or Range("A3")
Set rngSourceCell = Cells(3,1)
xlsPath = "C:\MyPath"
xlsFilename = "MyBook.xls"
sourceSheetName = "Sheet1"
rngDestinationCell.Formula = "=" _
& "'" & xlsPath & "\[" & xlsFilename & "]" & sourceSheetName & "'!" _
& rngSourceCell.Address
The other answers present fine solutions as well, perhaps more elegant than this.
brettdj and paulsm4 answers are giving much information but I still wanted to add my 2 cents.
As iDevlop answered in this thread ( Copy data from another Workbook through VBA ), you can also use GetInfoFromClosedFile().
Some bits from my class-wrapper for Excel:
Dim wb As Excel.Workbook
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
xlApp.DisplayAlerts = False ''# prevents dialog boxes
xlApp.ScreenUpdating = False ''# prevents showing up
xlApp.EnableEvents = False ''# prevents all internal events even being fired
''# start your "reading from the files"-loop here
Set wb = xlApp.Workbooks.Add(sFilename) '' better than open, because it can read from files that are in use
''# read the cells you need...
''# [....]
wb.Close SaveChanges:=False ''# clean up workbook
''# end your "reading from the files"-loop here
''# after your're done with all files, properly clean up:
xlApp.Quit
Set xlApp = Nothing
Good luck!
At the start of your macro add
Application.ScreenUpdating = false
then at the end
Application.ScreenUpdating = True
and you won't see any files open as the macro performs its function.
Related
I want to copy cells of a certain colour in "Hacked" workbook to the "Official" workbook. I also want to loop across multiple sheets. Right now I am only testing on one sheet and the loop is already getting stuck.
Sub CopyBasel2()
Dim Hacked As Workbook
Set Hacked = Workbooks.Open("H:\BASEL Reporting - Oliver's Mock\Report Submission\BASEL2_0262CRT30062021G (Password Breaker).xls")
Dim Official As Workbook
Set Official = Workbooks.Open("H:\BASEL Reporting - Oliver's Mock\Report Submission\BASEL2_0262CRT30062021G.xls")
Dim Cell As Range
For Each Cell In Hacked.Sheets("SA-CR.1(CE)").UsedRange.Cells
If Cell.Interior.Color = 13434828 Then
Official.Sheets("SA-CR.1(CE)").Range(Cell.Address).Value = Cell.Value
End If
Next Cell
Debug.Print Hacked.Sheets("SA-CR.1(CE)").Range("C10").Interior.Color
End Sub
Thanks everyone for your guidance, I have managed to get my code to work as below, complete with a loop through an array of sheets.
The reason my earlier code couldn't work was because I was opening the "Official" file at the same time. When I closed it and ran my code, it ran smoothly. Anyone know the logic behind this?
Also, if anyone has a better/more elegant way of doing the array and the loops part, please feel free to share it.
Sub CopyBasel2()
Dim Hacked As Workbook
Set Hacked = Workbooks.Open("H:\BASEL Reporting - Oliver's Mock\Report Submission\BASEL2_0262CRT30062021G (Password Breaker).xls")
Dim Official As Workbook
Set Official = Workbooks.Open("H:\BASEL Reporting - Oliver's Mock\Report Submission\BASEL2_0262CRT30062021G.xls")
With Hacked
Set WSArray = .Sheets(Array("SA-CR.1(CE)", "SA-CR.2(CRM.1)", "SA-CR.3(CRM.2)", "SA-CR.4(RWA)", _
"SA-CR.6(OBS)", "SA-CR.6.1(CD)", "SA-CR.7(Recon)"))
End With
For Each ws In WSArray
For Each Cell In Hacked.Sheets(ws.Name).UsedRange
If Cell.Interior.Color = 13434828 Then
Official.Sheets(ws.Name).Range(Cell.Address).Value = Cell.Value
End If
Next Cell
Next ws
End Sub
I have an Access form with the drawing number D-A1ER-1378-1601-0 listed which is also stored in a file folder.
I use the code below to open the pdf drawing, which works fine.
Public Sub OpenDWG()
Dim strFile As String
Dim PathPDF As String
On Error GoTo Failure
PathPDF = DLookup("[FilePath]", "[SettingsDrawingFilePathTbl]", "ID = 4")
strFile = PathPDF & "\" & Screen.ActiveControl & ".pdf"
If Len(Dir(strFile)) Then
FollowHyperlink strFile
Else
MsgBox "No Document found for this Drawing Number, check Engineering Drawing Search File path in the Settings Tab and / drawing download files"
End If
Exit Sub
Failure:
MsgBox Err.Description
Err.Clear
End Sub
How do I adjust the strfile name
strFile = PathPDF & "\" & Screen.ActiveControl & ".pdf"
to get the form to open only the most recent file when a new version of the drawing is dropped into the folder. ie D-A1ER-1378-1601-0(2) will be the newest revision.
I would like to add a comment, but I don't have enough points ot comment.
I think that you can use the Dir function to get all files beginning with the same characters, or with wild cards, etc. I'll have to look into how exactly to do this. You could populate an array with these, and use code to scan the array to determine the latest file. Or you could populate a temporary table amd then use the table contents as the course to a combo box to have the user select the desired file, sorted with the latest one on top.
If I get a chance, I'll conjure up some sample code an post it.
My problem is that I need to open some excel files using VBA (for excel 2007) and extract the data. All the files I want to open are called "profit for January.xlsx", "profit for February.xlsx", and so on with only the month name changing, so I think I want to open a file called "profit for*". There is another file in the folder called "total revenue.xlsx" that I do not want to open.
If possible, I need the code to extract the data from the files in the folder, wherever the folder may be because I am sending this code to my colleagues to put into their own folders, which have the same file name formats etc but different paths.
I have the code to extract the data, which works, but it either imports all the data in the folder or none at all!
Any help on this would be much appreciated as I am an intern trying to get his foot in the door, and this would be quite a big break for me!
Further Information
So far I have the code below (I haven't included the dim's because I felt they may be unnecessary?), which I have drawn from other websites. I'm also finding that, in trying to open all the files in the folder, it is trying to open itself! If anyone could suggest how to improve this, I would be very grateful. I haven't been using VBA for very long, and have been finding this assignment quite tough!
The error box that comes up sometimes says that I need an 'object' for the variable sfilename, and I'm not sure how to do that without messing up another part of the code.
sub import data ()
ChDir ThisWorkbook.Path
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set sfolder = objFSO.GetFolder(ThisWorkbook.Path)
For Each sfilename In sfolder.Files
If sfilename <> "Total Revenue.xlsx" Then
Workbooks.Open Filename:= _
sfilename *'open the file*
Set sfilename = ActiveWorkbook *'set the file name as sfilename, so the single piece of code will work with the copy-loop*
b = Sheets.Count *'for the data-import loop*
Call ImportData *'call in the loop*
sfilename.Close *'close the file*
End If
Next
end sub
So far I have the code below (I haven't included the dim's because I felt they may be unnecessary?), which I have drawn from other websites. I'm also finding that, in trying to open all the files in the folder, it is trying to open itself! If anyone could suggest how to improve this, I would be very grateful. I haven't been using VBA for very long, and have been finding this assignment quite tough!
The error box that comes up sometimes says that I need an 'object' for the variable sfilename, and I'm not sure how to do that without messing up another part of the code.
Many thanks and kindest regards,
Mark
sub import data ()
ChDir ThisWorkbook.Path
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set sfolder = objFSO.GetFolder(ThisWorkbook.Path)
For Each sfilename In sfolder.Files
If sfilename <> "Total Revenue.xlsx" Then
Workbooks.Open Filename:= _
sfilename *'open the file*
Set sfilename = ActiveWorkbook *'set the file name as sfilename, so the single piece of code will work with the copy-loop*
b = Sheets.Count *'for the data-import loop*
Call ImportData *'call in the loop*
sfilename.Close *'close the file*
End If
Next
end sub
What are you using at the moment? For each file in folder?
Possibilities include
FileSystemObject
Dir
For i=1 to 12
Monthname(i)
EDIT
Sub import_data()
sPath = ThisWorkbook.Path
sTemplate = "\profit for qqq.xls"
For i = 1 To 12
sFileName = Replace(sTemplate, "qqq", MonthName(i))
''Just checking
If Dir(sPath & sFileName) <> "" Then
Workbooks.Open Filename:= _
sPath & sFileName
'open the file*
Set sFileName = ActiveWorkbook
'set the file name as sfilename, so the single
'piece of code will work with the copy-loop*
b = Sheets.Count
'*'for the data-import loop*
''Call ImportData
'*'call in the loop*
sFileName.Close
'*'close the file*
End If
Next
End Sub
First, thanks to those of you who gave me the suggestion on using "ThisWorkbook.Path". It worked like a charm.
However, my code walks through seven (7) workbooks and when using "ThisWorkbook.Path" I can not re-initialize the "This.Workbook". Let me elaborate.
This is the workbook where the Macro resides:
Workbooks("Financial_Aggregator_v3.xls").Activate
This is the first workbook where the code adds a tab and does sub-totals. Basically, ThisWorkbook.Path works here:
Workbooks("Chapter_7-10_Mechanical.xls").Activate
After doing what I need done with "Mechanical" I have the following code snippet, which never turns out TRUE:
Workbooks("Financial_Aggregator_v3.xls").Activate
If FileThere(ThisWorkbook.Path & Application.PathSeparator & "Chapter_7-90_ECS_1_LLC.xls") Then
The code for the function, which works for the "Mechanical" sheet is:
Function FileThere(FileName As String) As Boolean
FileThere = (Dir(FileName) > "")
End Function
FYI, I tried to break all of the different Workbooks into different Sub(), but that didn't work. I also triple-checked the name of the workbooks.
Thanks in advance.
"ThisWorkbook" in Excel.VBA is sort of like "Me", in that it only applies to the workbook (.XLS) that actually holds the VBA code that is executing the "ThisWorkbook". What you need to do is to use Workbook objects to abstract the particular workbook that you want to test or manipulate.
Try something like this:
Public Sub TestWB()
Dim CurrWB As Workbook
'To get a workbook into our object variable:'
Set CurrWB = Workbooks("Chapter_7-10_Mechanical.xls")
'To Change the .Path:'
CurrWB.SaveAs NewFileName, AddToMru:=True
End Sub
I need to version control a Microsoft Access 2007 database and application. Currently everything is contained in a single mdb file.
The application includes:
Forms
VBA code
Actual database
I would assume I need to separate the database from the forms/code. I would like to be able to version control the forms/code as text to support version diffs.
At the moment I don't have access to SourceSafe (I heard there may be some access support) so I would prefer a solution that would work with subversion or git.
Access 2007 has a feature where you can split a DB into its Tables/Queries (backend) and Forms/Reports (front-end). Since your question mentions only version controlling the forms and modules, this might be a more elegant solution. I don't know where modules go after the split, so that might be a stumbling block.
Microsoft offers VSTO (Visual Studio Tools for Office), which will let you develop in VS and run version control via any VS plugin (CVS/SVN/VSS/etc.).
Finally, you can just directly connect to Visual Source Safe. This MSKB article has some good information and background to go through, while this Office Online article is designed for getting you up and running.
Ultimately, I would suggest against taking the code out of Access if at all possible. Assuming the VBA editor is your primary development environment, you'll be adding extra steps to your development process that cannot easily be automated. Every change you make will need to be manually exported, diff'd, and stored, and there is no Application.OnCompile event that you could use to export the changes. Even tougher, you'll have to manually import all changed source files from other developers when they do checkins.
I use the code below to extract the vba code from Excel files, you may be able to modify this to extract from Access.
Sub ExtractVBACode(strSource, objFSO, strExportPath, objLogFile)
Dim objExcel
Dim objWorkbook
Dim objVBComponent
Dim strFileSuffix
Dim strExportFolder
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = true
Set objWorkbook = objExcel.Workbooks.Open(Trim(strSource))
strExportFolder = strExportPath & objFSO.GetBaseName(objWorkbook.Name)
If Not objFSO.FolderExists(strExportFolder) Then
objFSO.CreateFolder(strExportFolder)
End If
For Each objVBComponent In objWorkbook.VBProject.VBComponents
Select Case objVBComponent.Type
Case vbext_ct_ClassModule, vbext_ct_Document
strFileSuffix = ".cls"
Case vbext_ct_MSForm
strFileSuffix = ".frm"
Case vbext_ct_StdModule
strFileSuffix = ".bas"
Case Else
strFileSuffix = ""
End Select
If strFileSuffix <> "" Then
On Error Resume Next
Err.Clear
objVBComponent.Export strExportFolder & "\" & objVBComponent.Name & strFileSuffix
If Err.Number <> 0 Then
objLogFile.WriteLine ("Failed to export " & strExportFolder & "\" & objVBComponent.Name & strFileSuffix)
Else
objLogFile.WriteLine ("Export Successful: " & strExportFolder & "\" & objVBComponent.Name & strFileSuffix)
End If
On Error Goto 0
End If
Next
objExcel.DisplayAlerts = False
objExcel.Quit
End Sub
Can you extract the forms as XML perhaps?
I've struggled with this same problem. I originally wrote code very much like the existing answer. The trick is to get all of your modules onto the file system, but that method has some drawbacks. Going that route, you can get your forms and reports out of the VBA Projects, but you can't get them back in. So, I created a library as part of our Rubberduck VBE Add-in. The library I wrote takes care of importing and exporting all of your code to/from the VBA project to/from the repository as you seemlessly push, pull, and commit. It's a free and open source project, so feel free to download and install the latest version.
Here is an example of how the library is used. I'll be adding actual integration with the VBA editor in a future release.
Dim factory As New Rubberduck.SourceControlClassFactory
Dim repo As Rubberduck.IRepository
Dim git As ISourceControlProvider
Dim xl As New Excel.Application
xl.Visible = true
Dim wb As Excel.Workbook
Set wb = xl.Workbooks.Open("C:\Path\to\workbook.xlsm")
' create class instances to work with
Set repo = factory.CreateRepository(wb.VBProject.Name, "C:\Path\to\local\repository\SourceControlTest", "https://github.com/ckuhn203/SourceControlTest.git")
Set git = factory.CreateGitProvider(wb.VBProject, repo, "userName", "passWord")
' Create new branch to modify.
git.CreateBranch "NewBranchName"
' It is automatically checked out.
Debug.Print "Current Branch: " & git.CurrentBranch
' add a new standard (.bas) code module and a comment to that file
wb.VBProject.VBComponents.Add(vbext_ct_StdModule).CodeModule.AddFromString "' Hello There"
' add any new files to tracking
Dim fileStat As Rubberduck.FileStatusEntry
For Each fileStat In git.Status
' fileStat.FileStatus is a bitwise enumeration, so we use bitwise AND to test for equality here
If fileStat.FileStatus And Rubberduck.FileStatus.Added Then
git.AddFile fileStat.FilePath
End If
Next
git.Commit "commit all modified files"
' Revert the last commit, throwing away the changes we just made.
git.Revert