VBA Access CSV import issue from netdrive using shell - 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.

Related

More efficient way to write command prompts in VBA?

My macro for Word highlights specific words from a specified list for each document in a folder. At the end of the macro, I would like to append the names of each of these files to include "_Highlight" using the command line. I am not too familiar with using the Command Prompt in VBA, so my code ended up being messy.
I am trying to replicate the following command prompt in VBA.
for %a in (“C:\path\*.docx*”) do ren “%~a” “%~Na_Highlight%~Xa”
For the actual file path, I select a folder in FileDialog and store it in a variable to be used in the command prompt, strShellFldr. I am having some trouble concatenating all pieces of the code, especially with special characters, spaces, and quotation literals.
Here is what I tried:
The code below runs just fine, however it seems quite cumbersome. Is there a more efficient way to write this?
Shell.Run "cmd.exe /c" & "for %a in" & Chr(32) & "(" & Chr(34) & strShellFldr & Chr(34) & ")" & Chr(32) & "do ren" & Chr(32) & Chr(34) & "%~a" & Chr(34) & Chr(32) & Chr(34) & "%~Na_Hilight%~Xa" & Chr(34)
Is there a native VBA function that allows you to append a file name maybe?
Thank you for your help and my apologies for posting some wretched code on here.
This piece of VBA code can loop through a list of files in a given folder as input, and add "_Highlight" at the end of the name, just before the file extension:
example:
MyFile.txt --> MyFile_Hightlight.txt
Public Sub RenameFiles(Folder As String)
Dim oFSO As Scripting.FileSystemObject
Dim oFolder As Scripting.Folder
Dim oFile As Scripting.File
Dim ext As String
Dim Name As String
On Error GoTo ERROR_TRAP
Set oFSO = New Scripting.FileSystemObject
Set oFolder = oFSO.GetFolder(Folder)
For Each oFile In oFolder.Files
ext = Split(oFile.Name, ".")(UBound(Split(oFile.Name, ".")))
Name = Left$(oFile.Path, Len(oFile.Path) - Len(ext) - 1)
oFSO.MoveFile Name & "." & ext, Name & "_Highlight" & "." & ext
Next oFile
Set oFSO = Nothing
Set oFolder = Nothing
Set oFile = Nothing
Exit Sub
ERROR_TRAP:
Debug.Print "ERROR : RenameFiles (" & oFolder.Name & ")"
End Sub
Do not forget to add Microsoft Scripting Runtime reference first in your VB Editor.

Ms Access Get filename with wildcards or loop

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?

Using Excel VBA to run a CMD command

I would like to use Excel VBA to run a CMD command.
The basic cmd command is:
"C:\Program Files\example program.exe" -w C:\Program files\outputfile.file "dir1" "dir2" "dir n+1"
The first part is the location of the program that will merge the files together.
The second part is the file location of the outputted merged files.
And the "dir1".... is the files that will be merged together.
I have code that lists the files to be merged but struggling to get the CMD code to get it so it does what I want as mentioned above. I have tried the following:
Sub RunCMD()
Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
Dim locationofprogram as string
'dir of program that will do the merge
Dim outputfolder as string
'dir of where the merged file will go
Dim listoffiles as string
'list of files to be merged
wsh.Run "cmd.exe /S /C locationofprogram & " " & "-w" & " " & outputfolder & " " & listoffiles, windowStyle, waitOnReturn
End Sub
Thanks for the help!
You can always create a .bat file, run the file, then delete it.
MyFile = "C:\Bat-File\Bat-File.bat"
fnum = FreeFile()
Open MyFile For Output As #fnum
Print #fnum, "C:\Program Files\example program.exe -w C:\Program files\outputfile.file dir1 dir2 dir n+1"
Close #fnum
Shell MyFile, vbNormalFocus
' wait 10 seconds to let bat file finnish
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 10
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
' delete bat-file
kill MyFile
I can't test that example program runs without the " around the dir´s so you have to see what happens.
But if it does not work you need to double enclose the " or use & CHR(34) &
If in doubt, send the text to the Immediate Window to see if it still matches the syntax using:
Debug.Print "cmd.exe /S /C " & locationofprogram & " " & "-w" & " " & outputfolder & " " & listoffiles
If that works, use:
wsh.Run "cmd.exe /S /C " & locationofprogram & " " & "-w" & " " & outputfolder & " " & listoffiles, windowStyle, waitOnReturn

command line not working when run from vba

I'm trying to unzip a file via my VBA code. I'm using 7z command line to unzip the file. However the command works when run from normal command prompt but the same command is not working when run via VBA code.
Command:
"C:\Program Files\7-Zip\7z.exe" x "C:\Users\Public\AppData\Local\Temp\Sample.zip"
For further understanding, I'm trying to extract a docx file and that is why I am renaming it to .zip and then extracting.
Sub tst()
Dim MyFile As String, Outdir As String, Cmdstr As String
MyFile = Chr(34) & "c:\TMP\ratings.gz" & Chr(34)
Outdir = Chr(34) & "c:\tmp\0" & Chr(34)
Cmdstr = "c:\Program Files\7-Zip\7z.exe" & " e " & MyFile & " -o" & Outdir
Debug.Print Cmdstr
Call Shell(Cmdstr, 1)
End Sub
I've used this type of function (similar) to unzip the file.
Missing proper quoting, should be
Cmdstr = """c:\Program Files\7-Zip\7z.exe""" & " e " & MyFile & " -o" & Outdir
The Command Line Version of 7-Zip is 7za.exe rather than 7z.exe.
I'm not sure about running CLI applications with Shell method but next could work:
Cmdstr = "cmd /D /C " & """full path to 7za\7za.exe""" & " e " & MyFile & " -o" & Outdir
Edit. To retain folder structure, use 7z with x command rather than e command. While the e command copies all extracted files to one directory, the z command extracts files from an archive with their full paths in the current directory, or in an output directory if specified. So you could define Cmdstr as follows:
Cmdstr = """c:\Program Files\7-Zip\7z.exe""" & " x " & MyFile & " -o" & Outdir

Robocopy in VBA while using strings

I have a spreadsheet that we run to copy over a list of files/folders based on what we select. In each of these row's we have a few other formula's that with gather other information. What we are trying to do is use robocopy based on a cell's data using strings. Below is currently how we have it setup in VBA, but it does not seem to work.
sSource = Sheets("Sheet1").Range("A2").Value
sFile = Sheets("Sheet1").Range("F2").Value
sPath = Sheets("Sheet2").Range("C2").Value
Shell "cmd /c robocopy sSource sPath sFile"
sSource is a network drive with the full folder path (i.e. \server1\stuff\stuff2\files)
sPath is a local folder on the computer
sFile is just as it sounds, the file name
It appears that it runs successfully, but when I go to the sPath location, there are no files there, just an empty folder.
Your code is very close. You need to concatenate your variables. All that needs to change is the final line to be:
Shell "cmd /c robocopy " & sSource & " " & sPath & " " & sFile
strParms = " /s /xo /mir /zb /R:5 /W:5"
Shell "cmd /c robocopy " & sSource & " " & sPath & sFile & strParms
Replace your code line (Shell "cmd /c robocopy " & sSource & " " & sPath & " " & sFile) with above 2 lines and you'll find files in your destination folder
Actually you're missing "strParms" in your statement which I have added. I have tested and it will definitely work.