Home | What's New | Articles | Code Downloads | Tool Box | Links | Code Snippets  

File / Disk / Directories

Changing a disk's volume label

This code will change the name of disk

'Declarations section:

Private Declare Function SetVolumeLabel Lib "kernel32" Alias _
"SetVolumeLabelA" (ByVal lpRootPathName As String, _
ByVal lpVolumeName As String) As Long

Example of use SetVolumeLabel "C:\", "C_Drive"

Returns 0 on failure, 1 on success.


Finding the Windows and System directories

Us this code when you need to know here the system and window's directory its usually c:\windows\system and c:\windows\ but you can't count on this.   These functions will return the path to the windows and system directory.

'Declarations section:
Declare Function GetSystemDirectory Lib "kernel32" Alias _
"GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Function SystemDir() As String
    Dim Gwdvar As String, Gwdvar_Length As Integer
    Gwdvar = Space(255)
    Gwdvar_Length = GetSystemDirectory(Gwdvar, 255)
    SystemDir = Left(Gwdvar, Gwdvar_Length)
End Function
Function WindowsDir() As String
    Dim Gwdvar As String, Gwdvar_Length As Integer
    Gwdvar = Space(255)
    Gwdvar_Length = GetWindowsDirectory(Gwdvar, 255)
    WindowsDir = Left(Gwdvar, Gwdvar_Length)
End Function

Find a Filename in the Path

The SearchPath API call will find a file that is in the path.  SearchPath searches directories in the following order:

  1. The directory from which the application loaded.
  2. The current directory.
  3. The System directory (System or System32)
  4. The Windows directory
  5. The directories that are listed in the PATH environment variable.
'Declarations section:
Private Declare Function SearchPath Lib "kernel32" Alias "SearchPathA" _
(ByVal lpPath As String, _
ByVal lpFileName As String, _
ByVal lpExtension As String, _
ByVal nBufferLength As Long, _
ByVal lpBuffer As String, _
ByVal lpFilePart As String) As Long

If the file is found it places the file's path in to lpBuffer.  The follwing code will search for the file mspaint.exe.

Dim lpBuffer As String * 512
    Dim BufferLength As Long
    Dim SearchPathLength As Long
    Dim FilePath As String
    
    BufferLength = Len(lpBuffer)
    SearchPathLength = SearchPath(vbNullString, "mspaint.exe", vbNullString, _
    BufferLength, lpBuffer, vbNullString)
    FilePath = Left$(lpBuffer, SearchPathLength)
    
    If Len(FilePath) > 0 Then
        MsgBox FilePath
    Else
        MsgBox "File Not Found"
    End If

If you want to skip the searching of the windows directory you could use this.

SearchPathLength = SearchPath(Environ("PATH"), "java.exe", vbNullString, BufferLength, lpBuffer, vbNullString)


Finding the Executable Associated with a File

This code will give you the name of the executable associated with the filename specified in lpFile.

' Place in General Declaration of a form
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long

Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

Use this to find the executable associated with the file.

    Dim lpExecutable As String * 255
    Dim lngReturn As Long
    lngReturn = FindExecutable("c:\mydir\myfile.txt", vbNullString, lpExecutable)
    
    Select Case lngReturn
        Case 0
            MsgBox "The system is out of memory or resources."
        Case 31
            MsgBox "0 The system is out of memory or resources."
        Case ERROR_FILE_NOT_FOUND
            MsgBox " The specified file was not found."
        Case ERROR_PATH_NOT_FOUND
            MsgBox "The specified path was not found."
        Case ERROR_BAD_FORMAT
            MsgBox "The .exe file is invalid (non-Win32 .exe or error in .exe image)."
        Case Else
            MsgBox lpExecutable
    End Select

Deleting a file to the Recycle Bin.

The built in VB function Kill will delete a file permanently from disk.  This code will delete a file to the recycle bin giving the user the option of getting it back if the recycle bin hasn't yet been emptied.

'Declarations section:
Private Type SHFILEOPSTRUCT
	hwnd As Long
	wFunc As Long
	pFrom As String
       	pTo As String
        fFlags As Integer
      	fAnyOperationsAborted As Boolean
        hNameMappings As Long
       	lpszProgressTitle As String
End Type
Private Declare Function SHFileOperation Lib "shell32.dll"
        Alias  "SHFileOperationA" (lpFileOp As
        SHFILEOPSTRUCT) As Long
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
'No user interface will be displayed if an error occurs.
Private Const FOF_NOERRORUI = &H400
Private Const FOF_NOCONFIRMATION = &H10 ' Don't prompt the user.
Function KillToRecycleBin(ByVal strFileToDelete As String, _
	Optional ByVal PromptUser As Boolean = False) As Long
    Dim lngFlags As Long
    Dim FileOperation As SHFILEOPSTRUCT
    
    lngFlags = FOF_ALLOWUNDO Or FOF_NOERRORUI
    If Not PromptUser Then lngFlags = lngFlags Or FOF_NOCONFIRMATION
    
    With FileOperation
        .wFunc = FO_DELETE
        .pFrom = strFileToDelete
        .fFlags = lngFlags
    End With

    ' Returns 0 if no error
     KillToRecycleBin = SHFileOperation(FileOperation)
End Function

To send a file to the recycle bin use:

KillToRecycleBin "C:\TheFileToDelete.txt"

To prompt the user to send a file to the recycle bin use:

KillToRecycleBin "C:\TheFileToDelete.txt", True

Emptying the Recycle Bin

This code will empty the recycle bin.

'Declarations section:
'No dialog confirming the deletion of the objects will be displayed
Private Const SHERB_NOCONFIRMATION = &H1
'No dialog indicating the progress will be displayed
Private Const SHERB_NOPROGRESSUI = &H2
'No sound will be played when the operation is complete
Private Const SHERB_NOSOUND = &H4
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" _
(ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Function EmptyRecycleBin(Optional ByVal RecycleBinDrive As String, _
	Optional ByVal Slient As Boolean = True) As Long
    Dim lngFlags As Long

    If Slient Then
        lngFlags = SHERB_NOCONFIRMATION Or SHERB_NOPROGRESSUI Or SHERB_NOSOUND
    End If
    
    EmptyRecycleBin = SHEmptyRecycleBin(0, RecycleBinDrive, lngFlags)
End Function

To empty the recycle bin on all drives with out prompting the user use:

EmptyRecycleBin

To prompt the user to empty the recycle bin on all drives use:

EmptyRecycleBin , False

To empty the recycle bin on the "D:\" drive with out prompting the user use:

EmptyRecycleBin "D:\"

Creating a temporary file

This code will create a file prefixed with the first three characters that are specified in the sPrefix argument of CreateTempFile in the directory specified in sCreateIn.  If no directory is specified the file will be created in the temp directory.  The files created by this function have the .tmp extension..

'Declarations section:
Private Declare Function GetTempFileName Lib "kernel32" _
     Alias "GetTempFileNameA" (ByVal lpszPath As String, _
     ByVal lpPrefixString As String, ByVal wUnique As Long, _
     ByVal lpTempFileName As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Function CreateTempFile(sPrefix As String, Optional sCreateIn As String) As String
     Dim lReturn As Long
     Dim sTempFilename As String * 255
     
     If sCreateIn = "" Then
        lReturn = GetTempPath(255, sTempFilename)
        sCreateIn = Left$(sTempFilename, lReturn)
     End If
     
    lReturn = GetTempFileName(sCreateIn, sPrefix, 0, sTempFilename)
    
    CreateTempFile = Left$(sTempFilename, lReturn)
End Function

To create and return the name of a temporary file in the temp directory with the prefix "ABC" use:

sPathofTempFile = CreateTempFile("ABC")

To create and return the name of a temporary file in "C:\" with the prefix "ABC" use:

sPathofTempFile = CreateTempFile("ABC", "C:\")

Adding an item to and clearing the Recently used Documents menu

'Declarations section:
Private Const SHARD_PATHA = &H2
Private Declare Function SHAddToRecentDocs Lib "shell32.dll" _
  (ByVal uFlags As Long, ByVal lpBuffer As String) As Long

To add a short cut from the Documents menu to a file use:

SHAddToRecentDocs SHARD_PATHA, "C:\myfile.txt"

To clear the list of recently used files use:

SHAddToRecentDocs SHARD_PATHA, vbNullString

Getting the DOS short filename

This code changes long filenames to their equivalent short filename (in DOS 8.3 format).

'Declarations section:
Private Declare Function GetShortPathName Lib "kernel32" Alias _
"GetShortPathNameA" (ByVal lpszLongPath As String, _
 ByVal lpszShortPath As String, _
 ByVal cchBuffer As Long) As Long
Public Function ShortFileName(ByVal LongFileName As String) As String
    Dim strBuffer As String * 255
    Dim lngResult As Long

    lngResult = GetShortPathName(LongFileName, strBuffer, Len(strBuffer))
    
    ShortFileName = Left$(strBuffer, lngResult)
End Function

To get the short version of a filename use:

MsgBox (ShortFileName("C:\picture of my cats.gif")

If the file specified does not exist this function returns a zero length string.


Copying and Moving Files with and without a Progress Dialog

This code will copy or move files.  It will display the same dialogs that explorer does if the bPromptUser argument is set.

'Declarations section:
Private Type SHFILEOPSTRUCT
     hwnd As Long
     wFunc As Long
     pFrom As String
     pTo As String
     fFlags As Integer
     fAnyOperationsAborted As Boolean
     hNameMappings As Long
     lpszProgressTitle As String
End Type
Private Declare Function shFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FOF_ALLOWUNDO = &H40
'No user interface will be displayed if an error occurs.
Private Const FOF_NOERRORUI = &H400
Private Const FOF_SILENT = &H4      ' don't create progress/report
Private Const FOF_NOCONFIRMATION = &H10        ' Don't prompt the user.
Private Const FOF_FILESONLY As Long = &H80
Private Const FOF_SIMPLEPROGRESS As Long = &H100
Private Const FOF_NOCONFIRMMKDIR As Long = &H200
Private Const FO_MOVE As Long = &H1
Private Const FO_COPY As Long = &H2
' sFrom can be multiple files seperated by vbNullChar
' bFilesOnly: If true only files will be copied or moved if sFrom has wildcards. 
' e.g. C:\*.*
Function FileOperation(ByVal sFrom As String, ByVal sTo As String, _
 Optional bMoveFiles As Boolean = False, _
 Optional ByVal bPromptUser As Boolean = False, _
 Optional ByVal bFilesOnly As Boolean, _
 Optional ByRef bOperationAborted As Boolean) As Long
    Dim shFileOpt As SHFILEOPSTRUCT
    With shFileOpt

        .hwnd = Me.hwnd
        If bMoveFiles Then
            .wFunc = FO_MOVE
        Else
            .wFunc = FO_COPY
        End If
        .fFlags = FOF_ALLOWUNDO
        If Not bPromptUser Then .fFlags = .fFlags Or FOF_NOCONFIRMATION Or FOF_NOERRORUI
        If bFilesOnly Then .fFlags = .fFlags Or FOF_FILESONLY
        .pFrom = sFrom & vbNullChar & vbNullChar
        .pTo = sTo & vbNullChar & vbNullChar
    End With

    FileOperation = shFileOperation(shFileOpt)   ' Returns zero if no error
    bOperationAborted = shFileOpt.fAnyOperationsAborted
End Function

This code will move "C:\myfile.txt" to "D:\" without prompting the user:

Dim bOpAbort As Boolean
If FileOperation("C:\myfile.txt", "D:\", True, , , bOpAbort) <> 0 Then
	MsgBox "Error"
Else
	If bOpAbort Then
		MsgBox "An operation was aborted"
        End If
End If

Changing the FileOperation call to:

If FileOperation("C:\*.*", "D:\", False, True, , bOpAbort) <> 0 Then

Will copy all files on the C drive to the D drive prompting the user for more information if necessary.