I have found this code which allows me to drag and drop files onto to script icon and put them in a specified directory:
Const MyDestinationFolder = "C:\Temp\"
Const OverwriteExisting = True
Dim objFile,objFolder
Dim Arg
Set objFSO = CreateObject("Scripting.FileSystemObject")
If WScript.Arguments.Count > 0 Then
For Each Arg in Wscript.Arguments
Arg = Trim(Arg)
If InStr(Arg,".") Then
' Assume a File
Set objFile = objFSO.GetFile(Arg)
' Copy file to the Dest Folder using the same name
objFile.Copy MyDestinationFolder & objFile.Name,OverwriteExisting
Else
'Assume a Folder
Set objFolder = objFSO.GetFolder(Arg)
' Copy Folder to the Dest Folder
objFolder.Copy MyDestinationFolder, OverwriteExisting
End If
Next
End If
However I would like to make a script that runs and has a simple rectangle that says, drag and drop here. If this is at all possible, that would be great. Thanks!
You can add a GUI to VBScript programs by using "HTML Applications (HTAs)". Start your research here:
Introduction to HTML Applications (HTAs)
Extreme Makeover: Wrap Your Scripts Up in a GUI Interface
A Scriptomatic You Can Call Your Own
HTML Application
HTML Applications (HTAs)
Scripting Eye for the GUI Guy
and - of course
stackoverflow questions tagged hta
After second thoughts on "Drag & Drop", I found:
this claim and that .HTA (not tested)
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 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.
I'm trying to find all Access databases in a directory and Compact and Repair each without opening Access each time. I found the following article explaining how to find them and write to a file:
Batch file to find all Access Databases, but ideally I'd like to just find them and compact without writing to a file.
I have searched how to call the /compact command line functionality, but I don't know how to do it on the databases I find. Can a .bat file be written to do this? Something like:
#echo off
"C:\Program Files\Microsoft Office\Office14\MSACCESS.EXE" "C:\Databases\ /s" *.accdb /compact
Any help with the syntax is very much appreciated.
Consider using Access' dedicated CompactRepair method which you can run in VBA (inside an Access database or outside like in an Excel macro). The thing to note is Compact & Repair actually creates a copy of existing database and replaces it with original, so some file handling is needed.
VBA (inside MSAccess.exe)
Sub RunCompactDBs()
Dim path As String
Dim accfile As Variant
path = "C:\Databases\"
accfile = Dir(path & "*.accdb", vbDirectory)
Do While Len(accfile) > 0
bkfile = Replace(accfile, ".accdb", "_bk.accdb")
' CREATE COMPACTED BACKUP
Application.CompactRepair path & accfile, path & bkfile, False
' COPY TO ORIGINAL PATH
FileCopy path & bkfile, path & accfile
' DESTROY COMPACTED BACKUP
Kill path & bkfile
accfile = Dir
Loop
Set accApp = Nothing
End Sub
VBA (outside MSAccess.exe)
Sub RunCompactDBs()
Dim path As String
Dim accfile As Variant
Dim accApp As Object
Set accApp = CreateObject("Access.Application")
path = "C:\Databases\"
accfile = Dir(path & "*.accdb", vbDirectory)
Do While Len(accfile) > 0
bkfile = Replace(accfile, ".accdb", "_bk.accdb")
accApp.CompactRepair path & accfile, path & bkfile, False
FileCopy path & bkfile, path & accfile
Kill path & bkfile
accfile = Dir
Loop
Set accApp = Nothing
End Sub
And there's no reason to stick with VBA. Any language that can make a COM interface to the Access object library can run the compact and repair procedure like open-source languages:
Python
import os, glob, shutil
import win32com.client
# LAUNCH ACCESS APP
oApp = win32com.client.Dispatch("Access.Application")
for file in glob.glob("C:\\Databases\\*.accdb"):
bkfile = file.replace(".accdb", "_bk.accdb")
oApp.CompactRepair(file, bkfile, False)
shutil.copyfile(bkfile, file)
os.remove(bkfile)
oApp = None
R
library(RDCOMClient)
# LAUNCH ACCESS APP
oApp = COMCreate("Access.Application")
accfiles <- list.files(path="C:\\Databases\\", pattern="\\.accdb", full.names=TRUE)
for (file in accfiles){
bkfile = sub(".accdb", "_bk.accdb", file)
oApp$CompactRepair(file, bkfile, FALSE)
file.copy(bkfile, file, overwrite = TRUE)
file.remove(bkfile)
}
oApp <- NULL
gc()
PHP
# LAUNCH ACCESS APP
$acc = new COM("Access.Application", NULL, CP_UTF8) or Die ("Did not instantiate Access");
foreach (glob("C:\\Databases\\*.accdb") as $file) {
$bkfile = str_replace(".accdb", "_bk.accdb", $file);
$acc->Application->CompactRepair($file, $bkfile, false);
copy($bkfile, $file);
unlink($bkfile);
}
$acc = NULL;
unset($acc);
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