".gz" extraction problem via VBA Shell and 7z command line - vba

I'm trying to create a function that returns unpacked file. It's only 1 file in archive. The problem comes with an unpacking part. I'm trying to get unpacked archive to the same folder as archive. Shell returns different not 0 values. The name seems not to be too long: Len( myFullPath ) = 101. The file name is - VZN_2022.csv.gz (packed file name)
I do not see a result of unpacking: there are no unpacked file in the folder. I use the code below:
Function Foo (ByVal myFullPath as String) as Boolean ' myFullPath = folder path + "\" + filename
Call unpackeFile( CreateObject("Scripting.FileSystemObject").GetFile(myFullPath) )
End Function
Function unpackeFile(ByRef archive As Object) As Object
....
commandStr = "C:\Program Files\7-Zip\7zFM.exe e " & archive.Path
Call Shell(commandStr, 0)
....
End function
Debug.Print commandStr
C:\Program Files\7-Zip\7zFM.exe e \\av-fs01.av.local\profiles$\meltek\Desktop\VZN_2022.csv.gz

You need to wrap the path to the executable in quotation marks too, because it has a space in it - otherwise Shell will read up to the first space (i.e., C:\Program)and assume the rest are arguments:
Function unpackeFile(ByRef archive As Object) As Object
....
commandStr = Chr(34) & "C:\Program Files\7-Zip\7zFM.exe" & Chr(34) & " e " & Chr(34) & archive.Path & Chr(34)
Call Shell(commandStr, 0)
....
End function

Related

File Download via shdocvw.dll with custom headers

I need to download a really large file in msaccess via a vba application.
Using the objects MSXML2.ServerXMLHTTP.6.0 and WinHttp.WinHttpRequest.5.1 result in an error stating that there is not enough storage available to complete this operation. Therefore i resorted in using the DoFileDownload method from shdocvw.dll.
What i want to do is pass an extra header (an API key) to the request sent by the function.
Here is roughly what i want to do.
Private Declare Function DoFileDownload Lib "shdocvw.dll" _
(ByVal lpszFile As String) As Long
Public Sub Download()
sDownloadFile = StrConv(<link_to_download>, vbUnicode)
'set a header before calling DoFileDownload
Call DoFileDownload(sDownloadFile)
End Sub
How do i approach this problem?
A WebRequest downloading a whole file at once stores the whole data in response.
Although there are options to chunk response, using Wget is less coding, but more options.
Private Sub DownloadFileWget()
Const PathToWget As String = "" 'if wget is not in path use "Path\To\Wget"
Dim LinkToFile As String
Dim SavePath As String
With CreateObject("WScript.Shell")
LinkToFile = "http://download.windowsupdate.com/microsoftupdate/v6/wsusscan/wsusscn2.cab" 'huge file > 500MB
SavePath = "C:\doc" 'folder to save download
.CurrentDirectory = SavePath
.Run Chr(34) & PathToWget & "wget.exe" & Chr(34) & " --header='name: value' " & Chr(34) & LinkToFile & Chr(34) & " -N", 1, True
' -N: Continue download only if the local version is outdated.
End With
End Sub

How to list only file name?

I have program to find files in a directory and list them in a listbox, but the following code I'm using adds the full path for the file found.
Is there something I'm missing to make it only add the file name and not the full path?
If My.Computer.FileSystem.DirectoryExists(My.Computer.FileSystem.CurrentDirectory & "\" & Details.IDL.Text) Then
For Each FoundFile As String In My.Computer.FileSystem.GetFiles(My.Computer.FileSystem.CurrentDirectory & "\" & Details.IDL.Text)
ListBox.Items.Add(FoundFile)
Next
Else
My.Computer.FileSystem.CreateDirectory(My.Computer.FileSystem.CurrentDirectory & "\" & Details.IDL.Text)
End If
so to fix it i only had to put ListBox.Items.Add(IO.Path.GetFileName(FoundFile)) instead of ListBox.Items.Add(FoundFile)
Here is a working example to list file name individually with GetFileNameWithoutExtension, along with the way you are using GetFileName.
Dim fileName As String = "C:\mydir\myfile.ext"
Dim pathname As String = "C:\mydir\"
Dim result As String
result = Path.GetFileNameWithoutExtension(fileName)
Console.WriteLine("GetFileNameWithoutExtension('{0}') returns '{1}'", fileName, result)
result = Path.GetFileName(pathname)
Console.WriteLine("GetFileName('{0}') returns '{1}'", pathname, result)

How to copy a Folder Iterative in vb.net

i created a program that copies folders + content into a different location, but this doesn't work with Folders in sizes i work with (50GB). I currently have a recursive function but it seems that this exceeds the memory limits. The only solution I could think of by now was a CMD call like.
process.start("cmd", "/C xcopy /E /V /I /Y """ & srcfld & """ """ & targfld & """")
Please excuse my variable-names, I'm lazy when it comes to typing names.
EDIT: The requested function:
Public Sub ordkop(ByVal srcfld As String, ByVal targfld As String)
Directory.CreateDirectory(targfld)
Dim files() As String
files = Directory.GetFileSystemEntries(srcfld)
For Each element As String In files
If Directory.Exists(element) Then
CopyDir(element, Path.Combine(targfld, Path.GetFileName(element)))
Else
File.Copy(element, Path.Combine(targfld, Path.GetFileName(element)), True)
End If
Next
End Sub

VB.Net files are not zipping correctly

I have created a project in vb.net that saves a Solid Edge assembly in multiple formats and then zips those formats individually and deletes the unzipped files from the directory. Until very recently, the program was working fine. Now, however, the files are not zipped in the directory. All that happens is that a file with the extension .7z is created one level up (ie I want files to be zipped in C:\Folder\New Folder but the .7z file is created in C:\Folder). Here is some of the project code:
' The extensions are stored in the INI file and must be retrieved
Extension = GetIniValue("CADMakros", "FileFormatExtensions3D", "C:\Windows\RTSettings.INI")
' Checks if there are extensions in the INI file
If Extension = "" Or Extension = " " Then
MsgBox("Keine Erweiterungen in «RTSettings.ini» eingetragen")
Exit Sub
End If
' The extensions are separated by a ";" in the INI file
' Therefore, they are split up into separate strings and sorted in the NewExtensions array
'The NewExtensions array does not have a defined size so that an arbitrary number of extensions can be added to the INI file
NewExtensions = Extension.Split(";")
' The spaces are removed from the extension strings
For i = 0 To UBound(NewExtensions)
NewExtensions(i) = NewExtensions(i).Replace(" ", "")
Debug.Print(NewExtensions(i))
Next
' An array containing the filenames is created whose size is dependent on the number of extensions
' Therefore, the array size changes when the INI file is modified
Dim NewFileNames(NewExtensions.Count) As String
Dim zippedFileNames(NewFileNames.Length) As String
' Remove solid edge extension
FileName = Microsoft.VisualBasic.Left(FileName, InStrRev(FileName, ".") - 1)
' Uses the file name as a default response for the input box
FileName1 = InputBox("Dateinamen eingeben", DefaultResponse:=FileName)
If FileName1 = " " Then
MsgBox("Bitte Dateinamen eingeben")
Exit Sub
ElseIf FileName1 = "" Then
Exit Sub
End If
ProgressBar1.Value = 30
' Creates a new file name that acts as the path of the file
For k = 0 To (NewExtensions.Length - 1)
NewFileNames(k) = ChosenFile & "\" & FileName1 & NewExtensions(k)
Next
' The files are saved
For k = 0 To (NewFileNames.Count - 2)
objDocument.SaveAs(NewFileNames(k))
' The progress of the program is sent to the backgroundWorker so it can update the progress bar accordingly
BackgroundWorker1.ReportProgress(30 + (k / (NewFileNames.Count - 2)) * 65)
' The program must be given time to update the progress bar
System.Threading.Thread.Sleep(200)
Next
For j = 0 To NewFileNames.Length - 2
For i = 0 To UBound(NewExtensions)
If NewFileNames(j).Contains(NewExtensions(i)) Then
zippedFileNames(j) = NewFileNames(j).Substring(0, NewFileNames(j).Length - NewExtensions(i).Length)
zippedLocation(j) = zippedFileNames(j) + "-" + NewExtensions(i).Substring(1)
End If
Next
Next
' The files are zipped
Shell(zipPath & " a " & zippedLocation(0) & ".zip " & NewFileNames(0))
Shell(zipPath + " a " + zippedLocation(1) + ".zip " + NewFileNames(1))
Shell(zipPath + " a " + zippedLocation(2) + ".zip " + NewFileNames(2))
'Dim save As New ProcessStartInfo(zipPath)
'save.Arguments = zipPath & " a -tzip " & zippedLocation(0) & ".zip " & NewFileNames(0)
'Process.Start(save)
' The program is given time to zip the file before it is deleted (this ensures the zipped file contains the required information)
Thread.Sleep(2000)
''The unzipped file is deleted from the computer
My.Computer.FileSystem.DeleteFile(NewFileNames(0))
My.Computer.FileSystem.DeleteFile(NewFileNames(1))
My.Computer.FileSystem.DeleteFile(NewFileNames(2))
ProgressBar1.Value = 100
The zip command is near the bottom (they are shell commands). Sorry about the message box messages, they're in German because I'm doing this for a German company.
Thank you in advance!

Get and edit a file name

I'm looking to retreive a txt file and then edit the file name (adding "converted" to the file name) and extension (from .r01 to .txt).
The purpose for this is so I can know if the txt file has been converted
Here's my code so far;
Dim infilename As Variant
infilename = Application.GetOpenFilename("Text & r01 Files (*.r01;*.txt),*.r01;*.txt", , "Open Neutral File", "OPEN")
InStrRev will allow you to find the last . and remove it and everything following from the string
FileNameWithoutExt = Left(Filename, InStrRev(Filename, ".") - 1)
An example with the workbooks FullName:
?activeworkbook.FullName
Z:\Individual Folders\Sean\transfers2.xlsx
?Left(activeworkbook.FullName, InStrRev(activeworkbook.FullName, ".") - 1)
Z:\Individual Folders\Sean\transfers2
You can wrap these in a function to make them easier to use. I've also added a function that will give the filename only instead of the one with the full path
Function FileNameOnly(fName)
'Changes "C:\Path\Filename.ext" to "Filename.ext"
FileNameOnly=mid(fName,instrrev(fName,"\")+1)
End Function
Function DelExt(fName)
'Changes "C:\Path\Filename.ext" to "C:\Path\Filename"
DelExt=left(fName,instrrev(fName,".")-1)
End Function
You can then use these in your program, with a line like NewFileName=DelExt(infilename) & "CONVERTED.txt"
I managed to get what I was looking for using part of Sean Cheshire's code.
Dim newFileName As Variant
newFileName = Left(inFileName, (InStrRev(inFileName, ".") - 1)) & "CONVERTED.txt"