VBA: Unzip files
By · CommentsThis code will extracts files from a ZIP archive.
Function UnZip(PathToUnzipFileTo As Variant, FileNameToUnzip As Variant)
' Unzips a file
' Note that the default OverWriteExisting is true unless otherwise specified as False.
Dim objOApp As Object
Dim varFileNameFolder As Variant
varFileNameFolder = PathToUnzipFileTo
Set objOApp = CreateObject("Shell.Application")
' the "24" argument below will supress any dialogs if the file already exist. The file will
' be replaced. See http://msdn.microsoft.com/en-us/library/windows/desktop/bb787866(v=vs.85).aspx
objOApp.Namespace(varFileNameFolder).CopyHere objOApp.Namespace(FileNameToUnzip).items, 24
End Function
Note the 24 in the last line. This suppresses any dialog boxes in the event of the extracted file(s) already existing. See http://msdn.microsoft.com/en-us/library/windows/desktop/bb787866(v=vs.85).aspx for more details.
Improvements to this could could consist of checking to see if the extracted files exist and handling that by renaming, deleting, etc.
VBA: Copy, Move and Delete files and folders
By · CommentsThis post is from Ron de Bruin’s blog (http://www.rondebruin.nl/folder.htm).
On this page you can find example code to copy, move and delete files and folders.
There are three sections on this page :
1) Copy and Move files and folders
4) VBS script to clear the Temp folder
Copy and Move files and folders
Below are a few examples to copy and move files and folders.
For one file you can use the VBA Name and FileCopy function
and for entire folders or a lot of files use the other macro example’s
Sub Copy_One_File()
FileCopy "C:\Users\Ron\SourceFolder\Test.xls", "C:\Users\Ron\DestFolder\Test.xls"
End Sub
Sub Move_Rename_One_File()
'You can change the path and file name
Name "C:\Users\Ron\SourceFolder\Test.xls" As "C:\Users\Ron\DestFolder\TestNew.xls"
End Sub
Filesystemobject example code’s
Sub Copy_Folder()
'This example copy all files and subfolders from FromPath to ToPath.
'Note: If ToPath already exist it will overwrite existing files in this folder
'if ToPath not exist it will be made for you.
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
FromPath = "C:\Users\Ron\Data" '<< Change
ToPath = "C:\Users\Ron\Test" '<< Change
'If you want to create a backup of your folder every time you run this macro
'you can create a unique folder with a Date/Time stamp.
'ToPath = "C:\Users\Ron\" & Format(Now, "yyyy-mm-dd h-mm-ss")
If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If
If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
FSO.CopyFolder Source:=FromPath, Destination:=ToPath
MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath
End Sub
Sub Move_Rename_Folder()
'This example move the folder from FromPath to ToPath.
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
FromPath = "C:\Users\Ron\Data" '<< Change
ToPath = "C:\Users\Ron\Test" '<< Change
'Note: It is not possible to use a folder that exist in ToPath
If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If
If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
If FSO.FolderExists(ToPath) = True Then
MsgBox ToPath & " exist, not possible to move to a existing folder"
Exit Sub
End If
FSO.MoveFolder Source:=FromPath, Destination:=ToPath
MsgBox "The folder is moved from " & FromPath & " to " & ToPath
End Sub
Sub Copy_Files_Dates()
'This example copy all files between certain dates from FromPath to ToPath.
'You can also use this to copy the files from the last ? days
'If Fdate >= Date - 30 Then
'Note: If the files in ToPath already exist it will overwrite
'existing files in this folder
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim Fdate As Date
Dim FileInFromFolder As Object
FromPath = "C:\Users\Ron\Data" '<< Change
ToPath = "C:\Users\Ron\Test" '<< Change
If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
End If
If Right(ToPath, 1) <> "\" Then
ToPath = ToPath & "\"
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
If FSO.FolderExists(ToPath) = False Then
MsgBox ToPath & " doesn't exist"
Exit Sub
End If
For Each FileInFromFolder In FSO.getfolder(FromPath).Files
Fdate = Int(FileInFromFolder.DateLastModified)
'Copy files from 1-Oct-2006 to 1-Nov-2006
If Fdate >= DateSerial(2006, 10, 1) And Fdate <= DateSerial(2006, 11, 1) Then
FileInFromFolder.Copy ToPath
End If
Next FileInFromFolder
MsgBox "You can find the files from " & FromPath & " in " & ToPath
End Sub
Sub Copy_Certain_Files_In_Folder()
'This example copy all Excel files from FromPath to ToPath.
'Note: If the files in ToPath already exist it will overwrite
'existing files in this folder
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
FromPath = "C:\Users\Ron\Data" '<< Change
ToPath = "C:\Users\Ron\Test" '<< Change
FileExt = "*.xl*" '<< Change
'You can use *.* for all files or *.doc for word files
If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
If FSO.FolderExists(ToPath) = False Then
MsgBox ToPath & " doesn't exist"
Exit Sub
End If
FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
MsgBox "You can find the files from " & FromPath & " in " & ToPath
End Sub
Sub Move_Certain_Files_To_New_Folder()
'This example move all Excel files from FromPath to ToPath.
'Note: It will create the folder ToPath for you with a date-time stamp
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
Dim FNames As String
FromPath = "C:\Users\Ron\Data" '<< Change
ToPath = "C:\Users\Ron\" & Format(Now, "yyyy-mm-dd h-mm-ss") _
& " Excel Files" & "\" '<< Change only the destination folder
FileExt = "*.xl*" '<< Change
'You can use *.* for all files or *.doc for word files
If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
End If
FNames = Dir(FromPath & FileExt)
If Len(FNames) = 0 Then
MsgBox "No files in " & FromPath
Exit Sub
End If
Set FSO = CreateObject("scripting.filesystemobject")
FSO.CreateFolder (ToPath)
FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath
MsgBox "You can find the files from " & FromPath & " in " & ToPath
End Sub
Important !
Read this page from Chip Pearson first
http://www.cpearson.com/excel/Recycle.htm
From Chip’s site :
You need to remember, though, that Kill permanently deletes the file.
There is no way to “undo” the delete. The file is not sent to the Windows Recycle Bin
( Same for the macro’s that use the filesystemobject )
Sub DeleteExample1()
'You can use this to delete all the files in the folder Test
On Error Resume Next
Kill "C:\Users\Ron\Test\*.*"
On Error GoTo 0
End Sub
Sub DeleteExample2()
'You can use this to delete all xl? files in the folder Test
On Error Resume Next
Kill "C:\Users\Ron\Test\*.xl*"
On Error GoTo 0
End Sub
Sub DeleteExample3()
'You can use this to delete one xls file in the folder Test
On Error Resume Next
Kill "C:\Users\Ron\Test\ron.xls"
On Error GoTo 0
End Sub
Sub DeleteExample4()
'You can use this to delete the whole folder
'Note: RmDir delete only a empty folder
On Error Resume Next
Kill "C:\Users\Ron\Test\*.*" ' delete all files in the folder
RmDir "C:\Users\Ron\Test\" ' delete folder
On Error GoTo 0
End Sub
Sub Delete_Whole_Folder()
'Delete whole folder without removing the files first like in DeleteExample4
Dim FSO As Object
Dim MyPath As String
Set FSO = CreateObject("scripting.filesystemobject")
MyPath = "C:\Users\Ron\Test" '<< Change
If Right(MyPath, 1) = "\" Then
MyPath = Left(MyPath, Len(MyPath) - 1)
End If
If FSO.FolderExists(MyPath) = False Then
MsgBox MyPath & " doesn't exist"
Exit Sub
End If
FSO.deletefolder MyPath
End Sub
Sub Clear_All_Files_And_SubFolders_In_Folder()
'Delete all files and subfolders
'Be sure that no file is open in the folder
Dim FSO As Object
Dim MyPath As String
Set FSO = CreateObject("scripting.filesystemobject")
MyPath = "C:\Users\Ron\Test" '<< Change
If Right(MyPath, 1) = "\" Then
MyPath = Left(MyPath, Len(MyPath) - 1)
End If
If FSO.FolderExists(MyPath) = False Then
MsgBox MyPath & " doesn't exist"
Exit Sub
End If
On Error Resume Next
'Delete files
FSO.deletefile MyPath & "\*.*", True
'Delete subfolders
FSO.deletefolder MyPath & "\*.*", True
On Error GoTo 0
End Sub
How do I get the path of a special folder and open the folder ?
Sub GetSpecialFolder()
'Special folders are : AllUsersDesktop, AllUsersStartMenu
'AllUsersPrograms, AllUsersStartup, Desktop, Favorites
'Fonts, MyDocuments, NetHood, PrintHood, Programs, Recent
'SendTo, StartMenu, Startup, Templates
'Get Favorites folder and open it
Dim WshShell As Object
Dim SpecialPath As String
Set WshShell = CreateObject("WScript.Shell")
SpecialPath = WshShell.SpecialFolders("Favorites")
MsgBox SpecialPath
'Open folder in Explorer
Shell "explorer.exe " & SpecialPath, vbNormalFocus
End Sub
Sub VBA_GetSpecialFolder_functions()
'Here are a few VBA path functions
MsgBox Application.Path
MsgBox Application.DefaultFilePath
MsgBox Application.TemplatesPath
MsgBox Application.StartupPath
MsgBox Application.UserLibraryPath
MsgBox Application.LibraryPath
End Sub
Temp folder
Without code you can do this to open the temp folder
Start>Run
Enter %temp%
OK
Or use one of the two code examples
Sub GetTempFolder_1()
MsgBox Environ("Temp")
'Open folder in Explorer
Shell "explorer.exe " & Environ("Temp"), vbNormalFocus
End Sub
Sub GetTempFolder_2()
Dim FSO As Object, TmpFolder As Object
Set FSO = CreateObject("scripting.filesystemobject")
Set TmpFolder = FSO.GetSpecialFolder(2)
MsgBox TmpFolder
'Open folder in Explorer
Shell "explorer.exe " & TmpFolder, vbNormalFocus
End Sub
0 = The Windows folder contains files installed by the Windows operating sys
1 = The System folder contains libraries, fonts, and device drivers
Function to get logged in user name
By · CommentsThis code is from Charles Maxson’s blog (http://blogs.officezealot.com/charles/archive/2004/12/10/3574.aspx) and is posted here for my reference.
Excel VBA: Function to get logged in user name (plus the Environ Function)
One commonly asked task is how can you get the name of the current user of an Excel spreadsheet into a cell in the spreadsheet. A lot of people quickly stumble across the UserName property in VBA and create a function similar to this:
Function UserNameOffice() As String
UserNameOffice = Application.UserName
End Function
But as you know, that only returns the name of the user according to the registration information of Office. A lot of companies set that at something generic like “User”or “Registered Owner”. That’s not what you really want though right? You really want the user’s name based on their Windows login. How do you get that ?…. well it’s a little complicated with an API call from VBA as shown here is below:
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA"(ByVal lpBuffer As String, nSize As Long) As Long
Function UserNameWindows() As String
Dim lngLen As Long
Dim strBuffer As String
Const dhcMaxUserName = 255
strBuffer = Space(dhcMaxUserName)
lngLen = dhcMaxUserName
If CBool(GetUserName(strBuffer, lngLen)) Then
UserNameWindows = Left$(strBuffer, lngLen - 1)
Else
UserNameWindows = ""
End If
End Function
Then all you have to do in the cell of choice is enter the formula:
=UserNameWindows()
But as *Mike* reminded me in a comment on my original post (this is the updated version)….
There is the Environ Function in VBA that makes this a walk in the park without the API hassles:
Function UserNameWindows() As String
UserName = Environ("USERNAME")
End Function
Thanks *Mike* for bringing that up….
I remember using Environ to get the current location of the “My Documents“ folder for the current user:
MsgBox Environ("USERPROFILE") + "\My Documents"
So having my memory jarred on the Environ function, I thought I would check VBA help to see what else this Little gem provided. And boy, how disappointing Help was… here is what it looks like: Environ Help. Not too useful I thought… So I decided to figure it out on my own and loop thru all the arguments possible with Environ. Copy and run this little routine to see all that Environ offers:
MsgBox Environ("USERPROFILE") + "\My Documents"Public Sub EnvironFunction()
Dim nCount As Integer
nCount = nCount + 1
Do Until Environ(nCount) = ""
Debug.Print Environ(nCount)
nCount = nCount + 1
Loop
End Sub
There are lots of useful things in there including APPDATA, COMPUTERNAME, HOMEDRIVE, HOMEPATH, OS, USERDOMAIN and more… Hopefully you will find it useful and I won’t forget about it again.
****Nice to see blogging helps you remember what you forgot and that readers often help writers more than the other way around 
Here’s a complete list (that I know of) of the named arguments for the Environ Function:
| Environ arguments |
| ALLUSERSPROFILE |
| APPDATA |
| AVENGINE |
| CLIENTNAME |
| CommonProgramFiles |
| COMPUTERNAME |
| ComSpec |
| FP_NO_HOST_CHECK |
| HOMEDRIVE |
| HOMEPATH |
| INCLUDE |
| INOCULAN |
| LIB |
| LOGONSERVER |
| NUMBER_OF_PROCESSORS |
| OS |
| Path |
| PATHEXT |
| PROCESSOR_ARCHITECTURE |
| PROCESSOR_IDENTIFIER |
| PROCESSOR_LEVEL |
| PROCESSOR_REVISION |
| ProgramFiles |
| SESSIONNAME |
| SystemDrive |
| SystemRoot |
| TEMP |
| TMP |
| USERDOMAIN |
| USERNAME |
| USERPROFILE |
| VS71COMNTOOLS |
| WecVersionForRosebud.FF0 |
| windir |
gAttach! – Gmail attachments made easy!
By · CommentsMany applications have the built-in capability to send emails. For example, you can send a document from Microsoft Word, a PDF from Adobe Acrobat, or photos from Windows Explorer. The problem is that these don’t work with web-based email, including Gmail.
gAttach! allows you to easily attach files to new messages in Gmail or Google Apps Mail.
All the features available in Windows that were once only available to your desktop mail-using friends are now available to all Gmail users.
Website: http://www.gattach.net/index.html
Magic/Replace Data Cleanup
By · CommentsMagic/Replace is a web based tool to clean up data easily. It enables the user to copy data from a spreadsheet, csv (comma separated file), or a TSV (tab separated file) and make changes to all of the rows at once.
For example, if you had a column of data that contained a phone number without separators (1234567890), you could easily change the contents to be formatted to include separators (123-456-7890).
Magic/Replace will also change the case of the data in a field.
You would use Excel or some other more powerful tool for major data cleanup. However, Magic/Replace works well and is quick for simple data cleanup. Magic/Replace is brought to you by Dabble DB – an easy way to create online databases.
Website: http://cleanupdata.com/
Antivirus XP now Antivirus Plus
By · CommentsLike a big catfish going after a dough ball, folks are snapping up malware like it’s a $20 bill blowing across a parking lot. Specifically, we’re talking about the old “Antivirus XPâ€, which is now making the rounds re-branded as “Antivirus Plusâ€.
Behold… Read More→
Top 5 Free Online Storage Sites to Transfer 100MB Files
By · CommentsDon’t email large files. These free online services allow upto 100MB files to be saved and transferred.
Top 5 Freeware to Capture Screenshots in Windows
By · CommentsCapture application screenshots or portions of them to use in your blogs and reports. These screen capture freeware will come in handy.
Blank Canvas Gmail Signatures
By · Comments
Since moving to Gmail for all of my email accounts I have been on the lookout for various add-ins and tools that would enhance my email experience. One of the best tools I have found is Blank Canvas Gmail Signatures.
Blank Canvas Gmail Signatures is a Firefox extension that automatically inserts HTML signatures into your Gmail messages based on which address you are sending from. Works for Compose Message and Reply/Forward.
From the Blank Canvas Gmail Signatures home page this plug-in provides the following features:
- Works for Compose Mail, Reply, and Forward
- Support for single or multiple email addresses
- Create a different signature for each email address you use in your Gmail account
- Supports up to four signatures per address
- Real-time signature preview while editing signature HTML
- Signature automatically inserted into message above (or optionally below) quoted text
- Support for special characters
- Easy setup and configuration interface
Developer Tools
By · CommentsThere are several blogs that have list of developer tools that are favorites. I will point to them from here so the list will be easy to find.
Steve Michelotti has a good list: http://geekswithblogs.net/michelotti/archive/2008/11/23/developer-tools-and-utilities.aspx
Scott Hanselman’s ComputerZen.com is the granddaddy of the list of developer tools: http://www.hanselman.com/tools
Ronda Tipton also has a good list of tools and applications: http://rtipton.wordpress.com/2008/12/06/tools-that-i-use-daily/
