VBscript for packing files - vb.net

I am very rusty in VB since it has been two years I have used it. I will soon be diving back into it because I have more of a reason now to use it than ever. Right now I am trying to create a VB script that will help me modify some files. I currently need a way to take a folder and package them a certain way. What I am trying to do is this:
Take a folder with client name
Create a zip file with said client name
Add a certain file to it first which will not change (ship.xml)
Take contents of client folder and add to zip folder.
Rename .zip to .tar format
Also if you know any good site tutorials on VB please let me know. I am using Visual Basic 2010 ultimate.

Don't know exactly what you mean with clientname (computername ?), but this should get you started, you can add the rest yourself otherwise you'll stay rusty 8>)
zip = "c:\myzip.zip"
source = "G:\script\zip"
set fso = createObject("Scripting.FileSystemObject")
set shell = createObject("shell.application")
'make empty zip
set file = fso.CreateTextFile(zip, True)
file.write("PK" & chr(5) & chr(6) & string(18,chr(0)))
file.close
set objFolder = shell.NameSpace(source)
set oZip = shell.NameSpace(zip)
if not oZip is nothing then
'add files to zip
oZip.CopyHere objFolder
wait_until_zipped(zip)
oZip.CopyHere "c:\ship.xml"
wait_until_zipped(zip)
'rename the zip to tar
fso.MoveFile zip, "c:\myzip.tar"
end if
'cleanup
set oZip = Nothing
set shell = Nothing
set fso = Nothing
function wait_until_zipped(zip)
set handle = fso.getFile(zip)
do
wscript.sleep 500
max = handle.size
loop while handle.size > max
end function

Related

Save file without specifying Drive Location

I would like to specify where my new Excel file is saved in terms of the folder (e.g. the folder name is Input Data). However, I do not want to specify the drive that it is contained in (e.g. C:\Input Data), how should I go about it?
I saw that other people typically would specify the full file path to where the folder is e.g. C:\Input Data. However, I would like to drop the C:\ portion.
The expected result would be where the output file is saved in the folder called "Input Data"
Rather than trying to specify an unknown location you could use a system location. Not only will this be consistent (for each user) but it should be a location where files can be saved. Many systems have been set up not to allow folders to be created in the root of the C:\ drive.
Dim fso As Object
Dim pth As String
Set fso = CreateObject("Scripting.FileSystemObject") 'create a filesystemobject
pth = fso.buildpath(Environ("userprofile"), "Input Data") 'get the path
If Not fso.FolderExists(pth) Then fso.CreateFolder pth 'create the folder if required
pth = fso.buildpath(pth, "My Workbook Name.xlsm") 'get the save path
ThisWorkbook.SaveAs pth 'save
Set fso = Nothing
To see the other system folders see https://pureinfotech.com/list-environment-variables-windows-10/ You might prefer to use %TEMP%.
You will need to change the Save statement to suit

Random File Selector?

It's been years since I've used Visual Basic. I downgraded from 2017 to 2010 (The version I was using while I was in school). I figured VB would be the best way to attempt a solution. (Although I'm sure there are other languages that would do it as well.)
I'm looking to get back into programming. Let me get to the problem.
My friend has an ever growing amount of text documents in a folder, and he wants a program to choose one at random, and open it.
I thought I'd put a TextBox with a Button that would let him open the folder where he stores his files. Then this program would read the number of text files in that folder, and randomly generate a number between one and that number, select, and open the document with its default program (if it's text, notepad; if it's DocX then word.)
I've been sitting at a blinking cursor for 45 minutes. I've gone on YouTube for help with this project.
Any advice, or help you guys can give me? Does this need to be simplified?
That sounds like a reasonable strategy to me.
It might be worth displaying some sort of progress to the user, say by putting the name of current file name being read into the status bar, in case there's a long delay reading the file names due to the large number of files in the folder, and/or a slow-running network drive. If you do this, remember to put a DoEvents into your loop to allow screen updates to display.
There's a separate thread on how to open files in their native handler here.
Hope this helps - good luck!
Option Explicit
Public oFSO As Object
Public arrFiles()
Public lngFiles As Long
Sub Main()
Dim sPath As String
sPath = InputBox("Enter folder path", "Folder path")
' clear starting point
lngFiles = 0
Erase arrFiles
Set oFSO = CreateObject("Scripting.FileSystemObject")
Call recurse(sPath)
Randomize
Dim lngRandomFileNumber As Long
lngRandomFileNumber = CLng(lngFiles * Rnd) + 1
MsgBox "This is random file, that will be opened: " & arrFiles(lngRandomFileNumber)
Call CreateObject("Shell.Application").Open(arrFiles(lngRandomFileNumber))
End Sub
Sub recurse(sPath As String)
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Set oFolder = oFSO.GetFolder(sPath)
'Collect file information
For Each oFile In oFolder.Files
lngFiles = lngFiles + 1
ReDim Preserve arrFiles(lngFiles + 1)
arrFiles(lngFiles) = sPath & "\" & oFile.Name
Next oFile
'looking for all subfolders
For Each oSubFolder In oFolder.SubFolders
'recursive call
Call recurse(oSubFolder.path)
Next oSubFolder
End Sub
You can paste this code in any VBA supporting application (MS Access, MS Excel, MS Word), call VBA editor (Shift + F11) and paste this code. After that press F5 and select Main() function. You'll see prompt to enter folder path, and after that you would get random file path.
I think it should be understandable in practice to see what program do
Updated: #Belladonna mentioned it clearly, to open file in default program.
NB: This code is passes through subfolders also, if you want to exclude subfolders, you should comment the recursive call block in recurce function

How to save Outlook mails as .msg file with categories and other details?

It is easy to save emails in Outlook VBA with MailItem.SaveAs
But I don't see any option to save additional details like i.e. the Author and Categories.
The 3rd party program MessageSave allows to save mails with Categories and Author in .msg format. In Windows Explorer the columns Author and Categories show the same information like in Outlook.
Does anybody know how to save messages using Outlook VBA including these additional information?
I bought MessageSave and it's a good program but they don't allow their save function to be used in VBA. The only workaround is to let MessageSave save messages when they "arrive" in a specific folder. If necessary I can use this function but this is just a workaround.
Here is a sample how the emails saved with MessageSave are shown in Windows Explorer:
here is a process i followed: (win7 64)
web search "windows vba set extended file property"
first hit: StackOverfow 16989882
web search: "DSOFile.OleDocumentProperties"
hit microsoft: The Dsofile.dll files lets you edit Office document properties when you do not have Office installed
https://support.microsoft.com/en-us/help/224351/the-dsofile.dll-files-lets-you-edit-office-document-properties-when-yo
that is not a typo ... it ends in "when-yo"
download: DsoFileSetup_KB224351_x86.exe
open DsoFileSetup_KB224351_x86.exe using 7-zip program (from 7-zip.org)
copy dsofile.dll from DsoFileSetup_KB224351_x86.exe (using 7-zip) into a folder desktop (named "testFiles" in this example) (this could be anywhere ... maybe windows system32 or syswow64 ... i only tried on desktop )
open command prompt window as administrator
navigate to folder that contains dsofile.dll
execute following: regsvr32 dsofile.dll
should receive success confirmation
start outlook ... vba editor ... tools ... references
and find "DSO OLE Document Properties Reader 2.1" and check the box on left
back to vba editor ... create new module
paste in the following: (this is just a minimal test script)
Sub extendedProperties()
Dim objFile As OleDocumentProperties
Set objFile = CreateObject("DSOFile.OleDocumentProperties")
objFile.Open ("C:\Users\js\Desktop\testFiles\myMessage.msg") ' adjust to match your system
objFile.SummaryProperties.Subject = "My Subject"
objFile.Save
Set objFile = Nothing
End Sub
copy (drag&drop) an email "myMessage" from outlook to folder (on desktop in this example)
right-click on folder column header ... click on more ... find "subject" ...
click checkbox
ran script
subject column should contain "My Subject" next to myMessage.msg (or whatever your message is named)
there may be a simpler way ... maybe windows PowerShell has a command that could be called from vba
here is a more usable script
it has no error checking
no check for duplicate message names
no check for illegal filenames (except for ":" character)
just select a bunch of emails in any outlook folder and run this
' make sure you have a reference to "DSO OLE Document Properties Reader"
Sub extendedProperties()
Dim msg As mailItem
Dim objFile As OleDocumentProperties
' Set objFile = CreateObject("DSOFile.OleDocumentProperties")
Set objFile = New OleDocumentProperties
Dim fileName As String
Dim subjectText As String
' !!!!!!!! select a bunch of messages before running this !!!!!!!!
For Each msg In ActiveExplorer.Selection
subjectText = Replace(msg.Subject, ":", "_") ' get rid of illegal file name character (there are others)
' adjust the destination folder for your liking
fileName = "C:\Users\js\Desktop\testFiles\" & subjectText & ".msg"
Debug.Print fileName
msg.SaveAs fileName
objFile.Open fileName
objFile.SummaryProperties.Subject = "My Subject"
'objFile.Save
objFile.Close True ' save and close !!!!! duplicate filenames get overwritten !!!!!
' stop ' uncomment this line and the code will stop. press F5 to run, F8 to single-step
Next msg
Set msg = Nothing
Set objFile = Nothing
End Sub

Downloading zip file from website using excel vba (if also able to extract the csv from zip file and open it in excel, then even better)

after quite some searching I've not been able to make a macro that would download a .zip file from a specific website. I mean I've been able to find similar problems but have not been able to apply the changes necessary in order for my problem to be solved. The website that contains the zip files is: https://nio.gov.si/nio/data/prvic+registrirana+vozila+v+letu+2014+po+mesecih, under table header "Priponke" are the files. For example: December 2014 (959 kb), November 2014 (1061 kb), ... The url that downloads the zip file for December 2014 is "cms/download/document/a7605005b6879fe5f7dbab6d60d4ae787dbced6b-1422453741279". I thank you in advance and am awaiting your reply.
My current code is:
Public Sub DownloadFile()
Dim objWHTTP As Object
Dim strPath As String
Dim arrData() As Byte
Dim lngFreeFile As Long
On Error Resume Next
Set objWHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
If Err.Number <> 0 Then
Set objWHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
End If
On Error GoTo 0
strPath = "https://nio.gov.si/nio/data/prvic+registrirana+vozila+v+letu+2014+po+mesecih"
strPath = "https://nio.gov.si/nio/cms/download/document/a7605005b6879fe5f7dbab6d60d4ae787dbced6b-1422453741279"
objWHTTP.Open "GET", strPath, False
objWHTTP.send
arrData = objWHTTP.responseBody
If Len(Dir("C:\FootieFile", vbDirectory)) = 0 Then
MkDir "C:\FootieFile"
End If
lngFreeFile = FreeFile
Open "C:\FootieFile\MyFile.xml" For Binary Access Write As #lngFreeFile
Put #lngFreeFile, 1, arrData
Close #lngFreeFile
Set objWHTTP = Nothing
Erase arrData
End Sub
Kind regards
You need to download a binary file, and save it. This can be done using the MSXML2.XMLHTTP60 object to download, and ADODB.Stream object for saving.
See e.g. http://www.motobit.com/tips/detpg_read-write-binary-files/
I've used this succesfully to download JPG files from a server and display them in an MS Access front end.
Also I hope you realize you can't start your url with 'cms', as you will need the fully qualified domain name plus resource (aka http:// etc)
Also be careful with unicode data. For that you might need to use StrConv(). Check after downloading that the size of your file is the same as it is on the server.

Kill Command Deleting Wrong File(s)i

In Access VBA, I have a procedure I've put together to do this:
Allow the user to select zip file(s)
Extract any files from the zip files to the same directory (In this
specific use-case instance, it is ALWAYS extracting Excel files from
Zip files, never any change, and always using the same password)
Then I want the code to Delete the Zip file after extracting the
.xls file.
Everything works beautifully except the delete file portion. The issue is that when I tell it to delete "FileName.Zip", it is deleting "FileName.Zip" AND "FileName.xls"
Is there any way to make sure that he kill command ONLY deletes what I want it to delete? I've used it before on various occasions, and never had this happen before.
Here is the code I am using:
Dim fd As FileDialog
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim i As Variant
Set db = CurrentDb
Set rs = db.OpenRecordset("tblProjectPath")
Set fd = FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = True
fd.Title = "Select TOC Return File(s) to process"
fd.InitialFileName = rs.Fields("ProjectPath") & "\FilingReports\*.zip"
fd.Show
For Each i In fd.SelectedItems
'Debug.Print i
Debug.Print '------------------------'
Debug.Print i
Unzip (i) 'The bit calling the command line unzip utility to unzip the file - just telling it to extract all files to the current folder.
Debug.Print i
'Kill i
'had to take out the kill bit, b/c it was deleting both the .zip and .xls files which is not desired nor expected
If InStr(i, ".zip") Then
Kill i 'Tried to specify only .zip files even though think I shouldn't need to, but it's still deleting .xls files
End If
Next i
Edit: Add Unzip code to post:
Unzip code:
Sub Unzip(Path As String)
Dim strUnzip As String
Dim QU As String 'quotation mark
QU = Chr(34)
strUnzip = QU & "c:\program files (x86)\winzip\wzunzip" & QU & " -s" & _
"ZipPassword " & _
Path & " " '& _
Call Shell(strUnzip)
End Sub
At this point, I don't really think a "real" answer will come about. However, I'll post what I've decided to do with the particular process I'm writing this code for anyway.
I'm going to use a folder structure to divide up the files:
1. Place zip file(s)
2. Unzip files to a 2nd folder
3. After processing Excel files in 2nd folder, move to a 3rd "complete" folder.
This will get around the deleting wrong files bit.
Also, it appears that the cause for the issue is related to something to do with the call to the WinZip Command Line Unzip utility (wzunzip) in the Unzip code above, or else something with the tool itself. I thought that maybe it was b/c the tool was asking me if I wanted to overwrite existing files, but that wasn't the case, b/c I had the same issue when there were no files to overwrite.
Anyway, I'm attempting to close this one up at this point. Thanks to Wayne G. Dunn for his assistance on this.