'' I created a folder like this and it contains many databases. When I'm about to submit again the button there was an error of "Database already exist" i am saying that I'm about to delete the src folder instead of the databases. What should I do then? What code to use?
Dim testPath1 As String = Form1.Dir_folder.Text & "\DDC OS" & "\CARD DECK" & "\" & DateTime.Now.ToString("yyyyMMdd") & "\" & batchFolderName & "\Compare"
Dim testPath5 As String = Form1.Dir_folder.Text & "\DDC OS" & "\CARD DECK" & "\" & DateTime.Now.ToString("yyyyMMdd") & "\" & batchFolderName & "\Entry1"
Dim testPath2 As String = Form1.Dir_folder.Text & "\DDC OS" & "\CARD DECK" & "\" & DateTime.Now.ToString("yyyyMMdd") & "\" & batchFolderName & "\Entry2"
Dim testPath3 As String = Form1.Dir_folder.Text & "\DDC OS" & "\CARD DECK" & "\" & DateTime.Now.ToString("yyyyMMdd") & "\" & batchFolderName & "\Images"
Dim testPath4 As String = Form1.Dir_folder.Text & "\CBATCH"
Dim testPath6 As String = Form1.Dir_folder.Text & "\CBATCH" & "\CardDeck" & "\" & DateTime.Now.ToString("yyyyMMdd")
If Not IO.Directory.Exists(testPath5) Then
MkDir(testPath5)
End If
If Not IO.Directory.Exists(testPath1) Then
MkDir(testPath1)
End If
If Not IO.Directory.Exists(testPath2) Then
MkDir(testPath2)
End If
If Not IO.Directory.Exists(testPath3) Then
MkDir(testPath3)
End If
If Not IO.Directory.Exists(testPath4) Then
MkDir(testPath4)
End If
If Not IO.Directory.Exists(testPath6) Then
MkDir(testPath6)
End If
To be honest MkDir isnt the quickest way to create directories, but for consistency, just use
RmDir(testPath1)
A better performing way would be to use..
My.Computer.FileSystem.CreateDirectory(testPath1)
to create a directory and ..
My.Computer.FileSystem.DeleteDirectory(testPath1,FileIO.DeleteDirectoryOption.DeleteAllContents)
to delete it/
You can't. My answer had nothing to do with using databases. Which is why I apologised for misreading your original question. I should delete it and let someone else answer.
Related
I am able to create a new directory on my desktop, my issues is that I don't know how to save multiple files into that folder, within the same Sub, since it has a dynamic name.
Option Explicit
Sub Make_Folder_On_Desktop()
Dim selectionsheet As Worksheet
Dim Group As Variant
Dim amount As Long
Dim BU As Long
Dim BUname As Variant
Dim sFilename As Variant
Set selectionsheet = Sheets("Project Selection")
Group = selectionsheet.Range("A19").Value
amount = selectionsheet.Range("B19").Value
BU = selectionsheet.Range("B6").Value
BUname = selectionsheet.Range("C6").Value
sFilename = BU & " - " & BUname
MkDir Group & " - " & amount & " - " & Format(Date, "mm-dd-yyyy") & " - "
& Format(Time, "hhmmss")
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sFilename
End Sub
Last line is where I'm having the issue. I have "ThisWorkbook.Path" but can't figure out how to get it into the new folder I just created.
MkDir Group & " - " & amount & " - " & Format(Date, "mm-dd-yyyy") & " - " & Format(Time, "hhmmss")
It's hard to know what the folder name is that you just created, because that instruction is responsible for too many things. Split it up.
Build/concatenate a folder name
Make a directory by that name
If we split up the work, things get much simpler:
Dim path As String
path = Group & " - " & amount & " - " & Format(Date, "mm-dd-yyyy") & " - " & Format(Time, "hhmmss")
MkDir path
And now we have the path in the ...path variable, readily usable for anything you might want to do with it:
ActiveWorkbook.SaveAs path & "\" & sFilename
As a side note, if you make the date format yyyy-mm-dd instead, you're ISO-compliant (i.e. the date is unambiguous everywhere in the world), and the folders become sortable by name.
Note that the procedure's name is misleading: it doesn't care where the folder is, and there's nothing that says it's under %USERPROFILE%\Desktop. Use Environ$("USERPROFILE") to retrieve the base path for the current user's profile directory.
I am using MS Access Forms and I am trying to open a file but don't know how to open the file based knowing only part of the name. Example below works
Private Sub Open_Email_Click()
On Error GoTo Err_cmdExplore_Click
Dim x As Long
Dim strFileName As String
strFileName = "C:\data\office\policy num\20180926 S Sales 112.32.msg"
strApp = """C:\Program Files\Microsoft Office\Office15\Outlook.exe"""
If InStr(strFileName, " ") > 0 Then strFileName = """" & strFileName & """"
x = Shell(strApp & " /f " & strFileName)
Exit_cmdExplore_Click:
Exit Sub
Err_cmdExplore_Click:
MsgBox Err.Description
Resume Exit_cmdExplore_Click
End Sub
If I change the strFilename to being
strFileName = "C:\data\" & Me.Office & "\" & Me.nm & " " & Me.pol & "\" & "*"& " S Sales " & Me.amt & "*" & ".msg"
It includes the * rather than using it as a wildcard, the date/numbers can be anything or in another format but always eight numbers. I tried using a while loop on the numbers but I am not sure the best way of doing this sorry.
You can use the Dir function to iterate over all files that match a string pattern.
strApp = """C:\Program Files\Microsoft Office\Office15\Outlook.exe"""
Dim strFilePattern As String
strFilePattern ="C:\data\" & Me.Office & "\" & Me.nm & " " & Me.pol & "\" & "*"& " S Sales " & Me.amt & "*" & ".msg"
Dim strFileName As String
strFileName = Dir(strFilePattern)
Do While Not strFileName = vbNullString
If InStr(strFileName, " ") > 0 Then strFileName = """" & strFileName & """"
x = Shell(strApp & " /f " & strFileName)
strFileName = Dir
Loop
The first call to Dir with the pattern as a parameter will find the first file that matches the pattern supplied. All subsequent calls without the pattern will return the next file that matches the pattern.
So, lets rebuild the question a bit. Imagine that you are having the following 5 files in a given folder:
A:\peter.msg
A:\bstack.msg
A:\coverflow.msg
A:\heter.msg
A:\beter.msg
and you need to find the files, that correspond to "A:\*eter.msg" and print them.
For this, you need to use the keyword Like:
Sub TestMe()
Dim someNames As Variant
someNames = Array("A:\peter.msg", "A:\bstack.msg", _
"A:\coverflow.msg", "A:\heter.msg", "A:\beter.msg")
Dim cnt As Long
For cnt = LBound(someNames) To UBound(someNames)
If someNames(cnt) Like "A:\*eter.msg" Then
Debug.Print someNames(cnt)
End If
Next
End Sub
Loop through files in a folder using VBA?
I am working on a backup script in VBS that creates a folder and then copies a powerpoint file into the most recently created folder.
Everything works great except MoveFile command at the bottom
Here is what I got so far (the bottom code is most important but just so everyone can understand where I am coming from):
sourceDir = "T:\Team"
destinationDir = "T:\Team\Archive\Archive"
const OverwriteExisting = True
intNum = 1
strDirectory = destinationDir & "_" & replace(date,"/",".") & "_" & intNum
'This checks if the folder exists and if not it will create a folder with the date and increment the folder name incase there are multiple updates in a single day.
if not filesys.FolderExists(destinationDir) then
While filesys.FolderExists(destinationDir & "_" & replace(date,"/",".") & "_" & intNum) = True
intNum = intNum + 1
Wend
Set archivefolder = filesys.CreateFolder(destinationDir & "_" & replace(date,"/",".") & "_" & intNum)
Else
Set archivefolder = filesys.CreateFolder(destinationDir)
Set objFolder = fso.CreateFolder(strDirectory)
End if
Dim thisday, thisdayy, thisdayyy
Today_Date()
' This is the problem code
filesys.MoveFile "T:\Arriva\Project_Organigram_" & thisday & "." & thisdayy & "." & thisdayyy & ".pptm", "destinationDir & "\" & Project_Organigram_" & thisday & "." & thisdayy & "." & thisdayyy & ".pptm"
Function Today_Date()
thisday=Right(Day(Date),2)
thisdayy=Right("0" & Month(Date),2)
thisdayyy=Right("0" & Year(Date),2)
End Function
This results in a folder being created as "T:\Team\Archive\Archive_03.12.2014_1
My goal is to be able to move the file in T:\Team to the dynamically created folder above.
Everything works great until the MoveFile part. The destination is the part throwing a "type mismatch" at the line where I define the strDirectory
I am just learning this type of programming so please let me know if I can provide any further details!
Thank you in advance!
You have a couple syntax errors with your quotes that are cancelling each other out. Change your line to this:
filesys.MoveFile "T:\Team\Project_Organigram_" & thisday & "." & thisdayy & "." & thisdayyy & ".pptm", "destinationDir" & "_" & replace(date,"/",".") & "_" & intNum & "\" & "Project_Organigram_" & thisday & "." & thisdayy & "." & thisdayyy & ".pptm"
I want to monitor a drive for file changes, using VBScript. I have the below code. It works fine for InstanceCreationEvent and InstanceDeletionEvent. But InstanceModificationEvent is not happening. From googling I got to know we need to use CIM_DataFile instead of CIM_DirectoryContainsFile to monitor InstanceModificationEvent. I am not sure how to modify the code. Can anyone help.
FYI: One script should monitor all the folders and subfolders in a drive.
PS: Any suggestion to improve the code and performance or other ideas also welcome.
My Code:
Dim arrFolders
Dim strComputer
Dim objWMIService
Dim strFolder
Dim strCommand
Dim i
Dim strQuery
strChangeFile = "MonitorFolder_Log.txt"
strMailIDFile = "MonitorFolder_MailIDs.txt"
'Check if the log file exists, if not ceate a new file and exit the script. Restart the script again.
Set oFSO = CreateObject("Scripting.FileSystemObject")
If not oFSO.FileExists(strChangeFile) then
'WScript.Echo "Change Log File Not Found. Creating new file..."
Set oTxtFile = oFSO.CreateTextFile(strChangeFile)
WScript.Echo strChangeFile & " File Created." & vbCrLf & "Please restart the script." & vbCrLf
WScript.Quit
End If
'Prompt for which drive should be monitored. If not a valid drive, then exit the script.
strDrive = InputBox("Enter the drive to monitor: " & vbCrLf & "E.g.: Input C to monitor C:\ drive.", "Monitor Folder - Oracle", "E")
If strDrive = "" then
WScript.Echo "Not a valid drive. Terminating the script."
WScript.Quit
End If
'Append ":" with the drive name.
strDrive = strDrive & ":"
'Read the mail IDs.
Set objFSOMailID = CreateObject("Scripting.FileSystemObject")
Set oTSMailID = objFSOMailID.OpenTextFile(strMailIDFile)
strMailIDsList = oTSMailID.ReadAll
oTSMailID.close
'WScript.Echo strMailIDsList
'Array to store the existing folder paths that should be monitored.
arrFolders = Array()
i = 0
Set FSO = CreateObject("Scripting.FileSystemObject")
ShowSubfolders FSO.GetFolder(strDrive)
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
i = i + 1
folderPath = "" & Subfolder.Path & ""
folderPath = Replace(folderPath ,"\","\\\\")
ReDim Preserve arrFolders(i)
arrFolders(i) = folderPath
'Wscript.Echo i & " " & arrFolders(i)
ShowSubFolders Subfolder
Next
End Sub
'Set the first path to be the drive.
arrFolders(0) = strDrive & "\\\\"
'Use WMI query to get the file changes.
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
'Loop throught the array of folders setting up the monitor for Each
i = 0
For Each strFolder In arrFolders
'Create the event sink
'WScript.Echo "setup for folder: " & strFolder & vbLf
strCommand = "Set EventSink" & i & " = WScript.CreateObject" & "(""WbemScripting.SWbemSink"", ""SINK" & i & "_"")"
ExecuteGlobal strCommand
'Setup Notification
strQuery = "SELECT * " _
& "FROM __InstanceOperationEvent " _
& "WITHIN 1 " _
& "WHERE Targetinstance ISA 'CIM_DirectoryContainsFile'" _
& " AND TargetInstance.GroupComponent = " & "'Win32_Directory.Name=""" & strFolder & """'"
strCommand = "objWMIservice.ExecNotificationQueryAsync EventSink" & i & ", strQuery"
ExecuteGlobal strCommand
'Create the OnObjectReady Sub
strCommand = "Sub SINK" & i & "_OnObjectReady(objObject, " & "objAsyncContext)" & vbLf _
& " 'Wscript.Echo objObject.TargetInstance.PartComponent" & vbLf _
& " SendNotification(objObject)" & vbLf _
& "End Sub"
'WScript.Echo strCommand
ExecuteGlobal strCommand
i = i + 1
Next
'Wait for events.
WScript.Echo "Waiting for events..."
i = 0
While (True)
Wscript.Sleep(1000)
Wend
Function SendNotification(objObject)
strEventType = objObject.Path_.Class
strPartComp = Split(objObject.TargetInstance.PartComponent, "=")
strFileName = Replace(strPartComp(1), "\\", "\")
WScript.Echo strEventType
WScript.Echo strFileName
'Some more code to send mail and logs...
End Function
Monitoring the entire filesystem for file creation is not feasible. It will eat up system resources and might severly affect system operation. Only ever monitor selected folders. The following should work:
Const Interval = 1
Set monitor = CreateMonitor("C:\foo")
Do
Set evt = monitor.NextEvent()
Select Case evt.Path_.Class
Case "__InstanceCreationEvent" : SendNotification evt.TargetInstance
Case "__InstanceModificationEvent" : ...
Case "__InstanceDeletionEvent" : ...
End Select
Loop
Function CreateMonitor(path)
Set wmi = GetObject("winmgmts://./root/cimv2")
Set fso = CreateObject("Scripting.FileSystemObject")
path = Split(fso.GetAbsolutePathName(path), ":")
drv = path(0) & ":"
dir = Replace(path(1), "\", "\\")
If Right(dir, 2) <> "\\" Then dir = dir & "\\"
query = "SELECT * FROM __InstanceOperationEvent" & _
" WITHIN " & Interval & _
" WHERE Targetinstance ISA 'CIM_DataFile'" & _
" AND TargetInstance.Drive='" & drv & "'" & _
" AND TargetInstance.Path='" & dir & "'"
Set CreateMonitor = wmi.ExecNotificationQuery(query)
End Function
Sub SendNotification(tgtInst)
'send notification
End Sub
You should run monitors for different folders as separate processes, because NextEvent() is a blocking operation.
I have a Sub within my application that is currently located within a userform called FRMPFC_folderCreatorWindow. For clarity of the overall application I wish to move this Sub from the userform into a Module called PFC_filesystemManipulation and call the Sub from there via a button in FRMPFC_folderCreatorWindow however, when I do this and run my code, an error is generated at the line:
For Each cCont In Me.Controls
I understand that this is because the Sub has been taken outside of the context of the form however, how do I maintain context without using Me.Controls? I'm guessing I need to reference the form and use FRMPFC_folderCreatorWindow.Controls but as most of the controls are nested within frames I'm unsure whether my current code acts upon the form or just the frame within which the button is located. Any help would be much appreciated.
Private Sub PFC_createFolders(Basepath, currentControl, parentFolder, parentGroup)
Dim cCont As Control
Dim createSubFolder As String
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
'Check if the project folder already exists and if so, raise an error and exit
MkDir Basepath & "\" & parentFolder
'Create the superceded documents folder in every 2nd generation folder
MkDir Basepath & "\" & parentFolder & "\" & "_Old versions"
For Each cCont In Me.Controls
If TypeName(cCont) = "CheckBox" Then
If cCont.GroupName = parentGroup Then
If cCont.Value = True Then
If cCont.Name <> currentControl Then
createSubFolder = cCont.Caption
NewFolder = Basepath & "\" & parentFolder & "\" & createSubFolder
If fs.folderexists(NewFolder) Then
'do nothing
Else
'Create 3rd generation folder
MkDir NewFolder
'Create the superceded documents folder in every 3rd generation folder
MkDir NewFolder & "\" & "_Old versions"
'Create hard-coded subfolders within Confirmit Exports
If createSubFolder = "Confirmit Exports" Then
MkDir Basepath & "\" & parentFolder & "\" & createSubFolder & "\Triple S"
MkDir Basepath & "\" & parentFolder & "\" & createSubFolder & "\Word Export"
MkDir Basepath & "\" & parentFolder & "\" & createSubFolder & "\Survey Definition"
MkDir Basepath & "\" & parentFolder & "\" & createSubFolder & "\Data"
MkDir Basepath & "\" & parentFolder & "\" & createSubFolder & "\Data" & "\" & "Early Data"
MkDir Basepath & "\" & parentFolder & "\" & createSubFolder & "\Data" & "\" & "Final Data"
End If
End If
End If
End If
End If
End If
Next cCont
End Sub
I've just experimented with this and replacing the Me.Controls with the following code works:
FRMPFC_folderCreatorWindow.Controls