I'm relatively new to VBA and working on something for work that will launch a given folder in explorer, run a search in explorer for files in that folder whose names contain a certain string, and show me the results in explorer. I've been using shell, and was able to individually open a specific folder, and run a search...but I can't figure out how to do both tasks simultaneously.
Here's some different things I've tried: nothing has worked.
Sub search_Files()
Dim folderName As String
folderName = "\\Users\itsMe\Documents"
Call Shell("C:\WINDOWS\explorer.exe "" "" & folderName _
&"" ""&search-ms://query=h&", vbNormalFocus)
Call Shell("explorer.exe "" ""search-ms:query=h&crumb=location:\\Users\itsMe\Documents", vbNormalFocus)
Call Shell("C:\WINDOWS\explorer.exe"" & FolderName &", vbNormalFocus)
RetVal = Shell( _
"c:\Windows\explorer.exe ""search-ms:displayname=Search%20Results&crumb=\\Users\itsMe\Documents" _
& h & "%20kind%3A%3Dfolder&crumb=location:" _
& folderName, vbNormalFocus)
End Sub
Could someone please provide me with the proper code on how to do this? (I want to use shell.)
Try this - it worked for me...
Call Shell("explorer.exe " & Chr(34) & "search-ms:query=*.pdf&crumb=location:c:\ad\" & Chr(34), vbNormalFocus)
Do you mean your code need to replace the fifth one as below? I am tried to modify the related destination folder already. But still fail. Not sure I did wrong in which step.
Sub search_Files()
Dim folderName As String
folderName = "C:\Users\lkam\Documents"
Call Shell("C:\WINDOWS\explorer.exe "" "" & folderName _
&"" ""&search-ms://query=h&", vbNormalFocus)
Call Shell("explorer.exe " & Chr(34) & "search-ms:query=*.pdf&crumb=location:c:\ad\" & Chr(34), vbNormalFocus)
Call Shell("C:\WINDOWS\explorer.exe"" & FolderName &", vbNormalFocus)
RetVal = Shell( _
"c:\Windows\explorer.exe ""search-ms:displayname=Search%20Results&crumb=C:\Users\lkam\Documents" _
& h & "%20kind%3A%3Dfolder&crumb=location:" _
& folderName, vbNormalFocus)
End Sub
Related
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 have an issue which i can't figure out.
Quest is to import csv file from a netdrive.
In a basic version files to import were selected automaticaly by code:
Function FilesAfterDate(Directory As String, FileSpec As String, AfterDate As Date) As String()
'Requires a reference to the Microsoft Scripting Runtime object lib
Dim oFS As New FileSystemObject, oFile As File
Dim listFiles() As String
Dim i As Long
i = 0
If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
For Each oFile In oFS.GetFolder(Directory).files
If oFile.DateLastModified > AfterDate And oFile.Name Like FileSpec Then
ReDim Preserve listFiles(i)
listFiles(i) = oFile.Name
i = i + 1
End If
Next
FilesAfterDate = listFiles
End Function
And then it was imported by code (for each Importfiles(i) where ImportReport = fullpath of Importfiles(i))
DoCmd.TransferText acImportDelim, "ImpSpec_" & sObjSpec & "Csv", "tb" & sObjName & cloneTableNameDesc, ImportReport, False
This solution works really slow, so with the help of the users of this portal I've created a shell import:
fileDetails = Split(CreateObject("wscript.shell").exec("cmd /c pushd " & Chr(34) & source_path & Chr(34) & " & forfiles /S /D +" & s_data & " & popd").StdOut.ReadAll, Chr(10))
and if I use same import command where ImportReport = fullpath of fileDetails (i) i get an error number 31519.
I used debug.print to check all vartypes, path etc and they are all the same. However sollution with shell doesn't work... Any idea for the reason why?
SOLVED:
As I figure it out - splitting shell function to array somehow doesn't have right data/names for access.
It worked when instead of splitting the shell function i've just assigned it to string value
full_string_paths = CreateObject("wscript.shell").exec("cmd /c pushd " & Chr(34) & source_path & Chr(34) & " & forfiles /S /D +" & s_data & " & popd").StdOut.ReadAll
and then using Mid function and Instr I've created an array of correct filename's
After that everything worked perfectly.
workers,
I have this code at the moment;
Public Sub SaveAsA1()
ActiveWorkbook.SaveAs Filename:=Range("P4").Value & ";" & Range("F6").Value & ";" & Range("R6").Value & ";" & Range("R4").Value
End Sub
Which i would like to modify to be saved in a certain filemap; \S31000265\Users$\NR4236\My Documents\TV-01-project\TestmapWeek9GOED. Been trying but it keeps overwriting the Filename-code. Hope you guys can help me out.
Public Sub SaveAsA1()
ChDir ("C:\work\testout\") ' Directory you need to save the file as xlsm
Filename = Range("P4").Value & ";" & Range("F6").Value & ";" & Range("R6").Value & ";" & Range("R4").Value
ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=52
End Sub
'' 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.
I am trying to write some code that will save several tabs as a pdf document in folder specified by files within excell. I would like for cells within the document to dictate where this file is saved. I am not sure if this is possibly, but if it is any help would be good! I am currently getting a Run-time error '1004' during the save process of my code.
And yes, I do have the folders created that are being referenced.
Sub asdf()
Dim Fname As String
Dim Fpath As String
Dim YrMth As String
Fname = Sheets("Sheet1").Range("A1").Text
YrMth = Sheets("Sheet1").Range("A2").Text & "\" & Sheets("Sheet1").Range("A3").Text
Fpath = "C:\Documents and Settings\My Documents\" & YrMth & "\Group\" & Fname & ".pdf"
ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet4")).Select
Application.DisplayAlerts = False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fpath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub
Your code works for me, but not with the path you've specified.
Declare a new string variable:
dim myDocsPath as String
Get the path using:
myDocsPath = Environ$("USERPROFILE") & "\My Documents\"
and then change your definition for Fpath to:
Fpath = myDocsPath & YrMth & "\Group\" & Fname & ".pdf"
If I change the end of myDocsPath to & "\My foo Documents\" I get the same 1004 error you are getting.
Try replace line in your code
Fpath = "C:\Documents and Settings\My Documents\" & YrMth & "\Group\" & Fname & ".pdf"
with
Dim WshShell As Object
Dim MyDocsFolder As String
Set WshShell = CreateObject("WScript.Shell")
MyDocsFolder = WshShell.SpecialFolders("MyDocuments") & "\"
Fpath = MyDocsFolder & YrMth & "\Group\" & Fname & ".pdf"
Edit:
The core of this solution is in line:
MyDocsFolder = WshShell.SpecialFolders("MyDocuments") & "\"
which returns system path to My Documents, irrespectively from local system settings like language or nonstandard location of My Documents folders. Then it adds a backslash at the end.
It is more elegant (and the code becomes more portable) if you ask system about special folders than hardcode such data in your script.
More on Windows special folders in VBA you can find https://www.rondebruin.nl/win/s3/win027.htm