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.
Related
I have 192000 images and I want to search for list of 7000 images names. and copy only these images. Is there any way to do it by coding or any way?
note: I use windows 10
I don't really understand the question but if you open the folder where are your images with the folder explorer, and you search the name of the wanted image, you can cut and paste all the images you have with the good name in an other folder.
I don't know if it's the answer you want sorry... But I hope it will help you
If you are storing the image file names in text file (one image file name per line) below vbs code can be useful
Set oFSO = CreateObject("Scripting.FileSystemObject")
sourceFolderPath = "C:\Selenium\images\"
targetFolderPath = "C:\Selenium\copied_images\"
Set oFile = oFSO.OpenTextFile("C:\Selenium\images\names.txt")
arr = Split(oFile.ReadAll(), vbNewLine)
For i = 0 To UBound(arr)
Filename = sourceFolderPath + arr(i)
If (oFSO.FileExists(Filename)) Then
oFSO.CopyFile Filename, targetFolderPath
End If
Next
set oFile = Nothing
set oFSO = Nothing
I have created a forum in vb6 and made connection with a database in access,everything went perfect.
my problem is in my form there is 2 combobox one to select Number and other to get me other numbers (watch the video to understand )
anyway the first combo is working and the second combo is working too but after selecting different number from the first combo i don't get anything in the second combo.anyway i know i just miss something in the code something very stupid
i have uploaded a video so you can see my problem, thanks in advance.
Private Sub Form_Load()
liaison
Do Until rspatient.EOF
Me.npa.AddItem rspatient.Fields(0)
rspatient.MoveNext
Loop
End Sub
Private Sub npa_Click()
rspatient.MoveFirst
Dim cr As String
cr = "npation ='" & npa & "'"
rspatient.Find cr
nom = rspatient.Fields(1)
prenom = rspatient.Fields(3)
rshospita.MoveFirst
nh.Clear
While rshospita.EOF = False
If UCase(rshospita.Fields(14)) = UCase(npa) Then
nh.AddItem rshospita.Fields(0)
End If
rshospita.MoveNext
Wend
End Sub
video for more detail :
https://www.youtube.com/watch?v=Tidm18_tvp0
The simplest possible reason for your problem is that you don't have any hospital records associated with your second patient. Check that first.
However, your code is also a bit convoluted. A simpler way to do what you want is to use Filter instead of Find. Filter restricts your recordset to only those records which match the filter, so you can simply iterate the filtered recordset the same way you do the whole one (rspatient). Something like this:
Private Sub npa_Click()
With rshospita
.Filter = ".Fields(14) = '" & npa & "'"
.MoveFirst
nh.Clear
Do Unitl .EOF
nh.AddItem .Fields(0)
.MoveNext
End With
End Sub
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.
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
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