Data Manipulation

This page contains VBA written to manipulate data

Import and merge multiple datasets

This VBA script imports multiple datasets into Microsoft Access, creates the union query and then runs then query to create a dataset table with all records. Datasets need to be in a folder called dataset on the C drive, VBA references need to include Microsoft Scripting runtime library, and add text import specification named dataset

'GIVE FOLDER NAME, ADD FOLDER TO C DRIVE
Const FolderName As String = "FOLDERNAME"

Public Sub get_files()

'MICROSOFT SCRIPTING RUNTIME
Dim oFSO As FileSystemObject
Dim objFolder As Folder
Dim objFiles As Files
Dim objFile As File

Dim db As Database
Dim tbl As TableDef
Dim fld As Fields
Dim strSQL As String
Dim qry As QueryDef

'GET FILES
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = oFSO.Drives("C").RootFolder.SubFolders(FolderName)
Set objFiles = oFSO.Drives("C").RootFolder.SubFolders(FolderName).Files

'IMPORT FILES - CREATE DATASET IMPORT SPECIFICATION
For Each objFile In objFiles
  DoCmd.TransferText acImportDelim, "dataset", objFile.Name, objFile.Path, True
Next

'CREATE UNION QUERY
strSQL = ""
For Each objFile In objFiles
 strSQL = strSQL & "Select * from [" & objFile.Name & "] "
 strSQL = strSQL & "Union "
Next
strSQL = Replace(strSQL, ".", "_")
strSQL = Left(strSQL, Len(strSQL) - 7)
strSQL = strSQL & ";"

Set db = CurrentDb
Set qry = db.CreateQueryDef("QryAllRecords")
qry.SQL = strSQL
db.QueryDefs.Refresh

'CREATE DATASET TABLE
Set qry = db.CreateQueryDef("QryDataset")
strSQL = ""
strSQL = "SELECT QryAllRecords.* INTO Dataset FROM QryAllRecords;"
qry.SQL = strSQL
db.QueryDefs.Refresh
db.QueryDefs("QryDataset").Execute
db.TableDefs.Refresh

MsgBox "Files imported and union dataset created"

End Sub

Remove non-printable and white-space characters

This VBA function replaces non-printable and white-space characters with character of choice

Function ReplaceClean(sText As String, Optional sSubText As String = " ")
    Dim j As Integer

    For j = 1 To 31
        sText = Replace(sText, Chr(j), sSubText)
    Next
    For j = 127 To 240
        sText = Replace(sText, Chr(j), sSubText)
    Next
    ReplaceClean = sText
End Function