Posts tagged ‘External Files’

May 14th, 2012

VBA – Read File into Memory

The following function enable you to read in, for instance a text file, into memory to use within your routines.

'---------------------------------------------------------------------------------------
' Procedure : ReadFile
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Faster way to read text file all in RAM rather than line by line
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strFile - name of the file that is to be read
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' MyTxt = ReadText("c:\tmp\test.txt")
' MyTxt = ReadText("c:\tmp\test.sql")
' MyTxt = ReadText("c:\tmp\test.csv")
'---------------------------------------------------------------------------------------
Function ReadFile(ByVal strFile As String) As String
On Error GoTo Error_Handler
    Dim FileNumber  As Integer
    Dim sFile       As String 'Variable contain file content

    'If FileExist(strFile) = False Then
    '    MsgBox "The specified file could not be found!"
    '    Exit Function
    'End If
    
    FileNumber = FreeFile
    Open strFile For Binary Access Read As FileNumber
    sFile = Space(LOF(FileNumber))
    Get #FileNumber, , sFile
    Close FileNumber
 
    ReadFile = sFile
 
Error_Handler_Exit:
    On Error Resume Next
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: ReadFile" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

c

September 16th, 2011

VBA – Determine if a Folder/Directory Exists or Not

It can often come handy to be able to quick determine if a Folder/Directory exists or not. Below is a function I created some time ago to do exactly that.

'---------------------------------------------------------------------------------------
' Procedure : FolderExist
' DateTime  : 2009-Oct-02 13:51
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Test for the existance of a Folder/Directory
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFolder - Full path of the folder to be tested for
'---------------------------------------------------------------------------------------
Function FolderExist(sFolder As String) As Boolean
On Error GoTo Error_Handler
 
    If sFolder = vbnullsring Then GoTo Error_Handler_Exit
    If Dir(sFolder, vbDirectory) <> vbNullString Then
        FolderExist = True
    End If
 
Error_Handler_Exit:
    On Error Resume Next
    Exit Function
 
Error_Handler:
    If Err.Number &lt;&gt; 52 Then
        MsgBox "The following error has occured" &amp; vbCrLf &amp; vbCrLf &amp; _
           "Error Number: " &amp; Err.Number &amp; vbCrLf &amp; _
           "Error Source: FolderExist" &amp; vbCrLf &amp; _
           "Error Description: " &amp; Err.Description, vbCritical, "An Error has Occured
    End If
    Resume Error_Handler_Exit
End Function
September 15th, 2011

VBA – Create Directory Structure/Create Multiple Directories/Create Nested Directories

One of he most common methods for creating directories/folders in VBA is to use the MkDir statement. For instance:

MkDir "C:\databases\"

One quickly learns the limitations of this technique the minute they have to create a directory structure with multiple sub-folders. MkDir can only create 1 directory at a time and cannot create a sub-directory. Hence, assuming that C:\databases does not already exist, the following would not work and will return an error!

MkDir "C:\databases\msaccess\"

If you absolutely want to create such a structure using the MkDir statement you’d have to do so using 2 MkDir statement. For instance:

MkDir "C:\databases\"
MkDir "C:\databases\msaccess\"

Now if you need to merely create 1 or 2 sub-folder MkDir may still be acceptable, but there are cases where this is simply impracticle and another solution needs to be found. Well, I found two possible solutions!

One possible approach can be found at Creating Nested Directories.

The second I found searching through the net and I no longer know the original source of the code (if someone knows e-mail me and I will put credit where it is due). It is a simple API which can create multiple directories in 1 call.

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
 
Public Sub MakeFullDir(strPath As String)
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 'Optional depending upon intent
    MakeSureDirectoryPathExists strPath
End Sub

Another possible solution, if someone wanted to tinker a little would be to merely parse the path into it’s directories and the using the DIR statement evaluate and create the directories where need be. Shouldn’t be that hard, but I haven’t taken the time to do this (maybe one day I will and will update this post then).

Okay, so it bothered me and I had to quickly put something together to stop my brain from churning! Below is what I pieced together rapidly. It is missing proper variable definitions (DIM statements) and error handling, but from my very brief testing, it does appear to work and doesn’t require any APIs! 100% VBA.

Public Sub MyMkDir(sPath As String)
    Dim iStart          As Integer
    Dim aDirs           As Variant
    Dim sCurDir         As String
    Dim i               As Integer
 
    If sPath <> "" Then
        aDirs = Split(sPath, "\")
        If Left(sPath, 2) = "\\" Then
            iStart = 3
        Else
            iStart = 1
        End If
 
        sCurDir = Left(sPath, InStr(iStart, sPath, "\"))
 
        For i = iStart To UBound(aDirs)
            sCurDir = sCurDir & aDirs(i) & "\"
            If Dir(sCurDir, vbDirectory) = vbNullString Then
                MkDir sCurDir
            End If
        Next i
    End If
End Sub

As you can see, there are numerous way to handles this issue. Hopefully this helped answer a question for a few of you out there!

November 15th, 2010

MS Access – VBA – Move A Folder

If you have ever tried to use the File Scripting Object to perform a FolderMove, you’ve quickly learnt that it spits out a Permission Denied error when you try to move a folder to another drive or try to move a folder which is not on the same drive as the move.exe. So how can you get around this problem, well actually, it is quite easy. The function below will perform the move for you. Instead of simply moving the directory, we actually copy it and then delete the source directory. Easy as pie! Enjoy

'---------------------------------------------------------------------------------------
' Procedure : MoveFolder
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Move a folder
'             Better version of the FSO's MoveFolder method which is basically a "rename"
'             method, hence it only works if the source and destination reside on
'             the same volume (same as move.exe under WinXP) and typically returns
'             a permission denied error.
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFolderSource         Folder to move
' sFolderDestination    Folder to move the folder to
' bOverWriteFiles       Whether to overwrite file(s) if the folder already exists
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' MoveFolder("C:\Temp", "D:\Development\New")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Nov-14                 Initial Release
'---------------------------------------------------------------------------------------
Function MoveFolder(sFolderSource As String, sFolderDestination As String, _
                    bOverWriteFiles As Boolean) As Boolean
On Error GoTo Error_Handler
    Dim fs As Object
 
    MoveFolder = False
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CopyFolder sFolderSource, sFolderDestination, bOverWriteFiles
    fs.DeleteFolder sFolderSource, True
    MoveFolder = True
 
Error_Handler_Exit:
    On Error Resume Next
    Set fs = Nothing
    Exit Function
 
Error_Handler:
    If Err.Number = 76 Then
        MsgBox "The 'Source Folder' could not be found to make a copy of.", _
                vbCritical, "Unable to Find the Specified Folder"
    Else
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: MoveFolder" & vbCrLf & _
               "Error Description: " & Err.Description, _
               vbCritical, "An Error has Occured!"
    End If
    Resume Error_Handler_Exit
End Function

November 14th, 2010

MS Access – VBA – Copy A Folder

Below is a simple little function which will allow you to make a copy of a folder since it uses the File Scripting Object it can be used in all VBA Applications (Word, Excel, Access, PowerPoint, …).

'---------------------------------------------------------------------------------------
' Procedure : CopyFolder
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Copy a folder
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFolderSource         Folder to be copied
' sFolderDestination    Folder to copy to
' bOverWriteFiles       Whether to overwrite file(s) if the folder already exists
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' CopyFolder("C:\Temp", "D:\Development\New", True)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Nov-14                 Initial Release
'---------------------------------------------------------------------------------------
Function CopyFolder(sFolderSource As String, sFolderDestination As String, _
                    bOverWriteFiles As Boolean) As Boolean
On Error GoTo Error_Handler
    Dim fs As Object
 
    CopyFolder = False
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CopyFolder sFolderSource, sFolderDestination, bOverWriteFiles
    CopyFolder = True
 
Error_Handler_Exit:
    On Error Resume Next
    Set fs = Nothing
    Exit Function
 
Error_Handler:
    If Err.Number = 76 Then
        MsgBox "The 'Source Folder' could not be found to make a copy of.", _
                vbCritical, "Unable to Find the Specified Folder"
    Else
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: CopyFolder" & vbCrLf & _
               "Error Description: " & Err.Description, _
               vbCritical, "An Error has Occured!"
    End If
    Resume Error_Handler_Exit
End Function

September 29th, 2010

MS Access – VBA – Copy a File

Have you ever needed to make a copy of a file? Well, there are a number of ways that you can do it. For instance, one could create a FileScripting instance, but I find that using the FileCopy function to be the simplest and cleaness method. I created a very simply procedure around it to trap certain common errors.

'---------------------------------------------------------------------------------------
' Procedure : CopyFile
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Copy a file
'             Overwrites existing copy without prompting
'             Cannot copy locked files (currently in use)
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strSource - Path/Name of the file to be copied
' strDest - Path/Name for copying the file to
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' 1         2007-Apr-01             Initial Release
'---------------------------------------------------------------------------------------
Function CopyFile(strSource As String, strDest As String) As Boolean
On Error GoTo CopyFile_Error
 
    FileCopy strSource, strDest
    CopyFile = True
    Exit Function
 
CopyFile_Error:
    If Err.Number = 0 Then
    ElseIf Err.Number = 70 Then
        MsgBox "The file is currently in use and therfore is locked and cannot be copied at this" & _
               " time.  Please ensure that no one is using the file and try again.", vbOKOnly, _
               "File Currently in Use"
    ElseIf Err.Number = 53 Then
        MsgBox "The Source File '" & strSource & "' could not be found.  Please validate the" & _
               " location and name of the specifed Source File and try again", vbOKOnly, _
               "File Currently in Use"
    Else
        MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
               Err.Number & vbCrLf & "Error Source: ModExtFiles / CopyFile" & vbCrLf & _
               "Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
    End If
    Exit Function
End Function

All you have to do is copy it into a module and then call it as required. Enjoy!