In this post, I am going to demonstrate a VBA class I built to help create dummy text files. Creating dummy files allows me to work with mock data, in the absence of any real data when working on new projects. The idea behind the class is to be able to create text files of any length and column size, and with as many different data types as possible. With dummy data I can start to build out the mechanics of a new import process for a new project and test out any potential issues with whatever setup I am dealing with. The class also creates the required SQL statement needed to create a table that fits my text file.
Preliminary Steps
If you are going to use the code within a new Workbook, make sure that the Microsoft Scripting Runtime reference is ticked within the VBE Reference Window:
The Text File Generator Class
This is the entire code for the textfile class which I named csTextFileGenerator:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 |
Option Explicit Private mblnIncludeHeader As Boolean Private mblnAddFileDateStamp As Boolean Private mstrPath As String Private mstrFileName As String Private mstrFileType As String Private mstrDelim As String Private mstrSQLTable As String Private mlngMaxRows As Long Private mintMaxFields As Long Private Const CINT_MAX_COLUMN_TYPES As Integer = 7 Private Const CINT_MAX_ASCII As Integer = 90 Private Const CINT_MIN_ASCII As Integer = 65 Private Const CINT_MAX_FIELDS As Integer = 12 Private Const CLNG_MAX_ROWS As Long = 10 Private Const CSTR_DEFAULT_DELIM As String = "," Private Const CSTR_DEFAULT_FILE_EXT As String = ".csv" Private Const CSTR_DEFAULT_FILE_NAME As String = "DummyData" Private Const CSTR_DEFAULT_TABLE_NAME As String = "DummyDataImportTable" Private Const CSTR_COLUMN_NAME_PREFIX As String = "Header" Private Sub Class_Initialize() mlngMaxRows = CLNG_MAX_ROWS mintMaxFields = CINT_MAX_FIELDS mstrDelim = CSTR_DEFAULT_DELIM mstrFileName = CSTR_DEFAULT_FILE_NAME mstrFileType = CSTR_DEFAULT_FILE_EXT mstrSQLTable = CSTR_DEFAULT_TABLE_NAME mblnIncludeHeader = True mblnAddFileDateStamp = True mstrPath = ThisWorkbook.Path End Sub Public Property Let RowCount(ByVal Value As Long) mlngMaxRows = Value End Property Public Property Let FieldCount(ByVal Value As Integer) If Value >= 1 Then mintMaxFields = Value End If End Property Public Property Let Delimiter(ByVal Value As String) mstrDelim = Value End Property Public Property Let IncludeHeader(ByVal Value As String) mblnIncludeHeader = Value End Property Public Property Let FileType(ByVal Value As String) mstrFileType = Value End Property Public Property Let Filename(ByVal Value As String) mstrFileName = Value End Property Public Property Let Filepath(ByVal Value As String) mstrPath = Value End Property Public Property Let FileNameDateStamp(ByVal Value As Boolean) mblnAddFileDateStamp = Value End Property Public Property Let SQLTableName(ByVal Value As String) mstrSQLTable = Value End Property Public Function GenerateTextFile() As Boolean On Error GoTo ERR_HANDLER: Dim strFile As String Dim strHeader As String Dim strRow As String Dim strFieldValue As String Dim intTypeCnt As Integer Dim intFieldCnt As Integer Dim lngRow As Long Dim fso As New FileSystemObject Dim ts As TextStream If mblnAddFileDateStamp Then mstrFileName = mstrFileName & "_" & Format(Now(), "YYYYMMDD") End If strFile = mstrPath & Chr(92) & mstrFileName & mstrFileType Set ts = fso.CreateTextFile(strFile, True) If mblnIncludeHeader Then For intFieldCnt = 1 To mintMaxFields strHeader = strHeader & IIf(strHeader <> Empty, mstrDelim, Empty) & _ CSTR_COLUMN_NAME_PREFIX & intFieldCnt Next ts.WriteLine (strHeader) End If For lngRow = 1 To mlngMaxRows DoEvents strRow = Empty intTypeCnt = 0 For intFieldCnt = 1 To mintMaxFields DoEvents strFieldValue = Empty Select Case intTypeCnt Case 0 strFieldValue = lngRow Case 1 strFieldValue = GetRandomString(25) Case 2 strFieldValue = GetRandomDate(True) Case 3 strFieldValue = GetRandomNumber(1, 0, 2) Case 4 strFieldValue = PickRandomFromArray(Array("A", "B", "C", "D", "E")) Case 5 strFieldValue = GetRandomString(4, True, True, 0.8) Case 6 strFieldValue = PickRandomFromArray(Array(1, 0)) Case 7 strFieldValue = GetRandomNumber(10000, 1, 10) End Select strRow = strRow & IIf(strRow <> Empty, mstrDelim, Empty) & strFieldValue intTypeCnt = intTypeCnt + 1 If intTypeCnt > CINT_MAX_COLUMN_TYPES Then intTypeCnt = 1 Next ts.WriteLine (strRow) Next GenerateTextFile = True EXIT_HERE: If Not ts Is Nothing Then ts.Close End If Set ts = Nothing Set fso = Nothing Exit Function ERR_HANDLER: Debug.Print Err.Description GenerateTextFile = False GoTo EXIT_HERE End Function Public Function CreateSQLFile() As Boolean On Error GoTo ERR_HANDLER: Dim strSQLFile As String Dim strSQL As String Dim fso As FileSystemObject Dim ts As TextStream Dim intTypeCnt As Integer Dim intFieldCnt As Integer Dim arrSQLServerDataTypes() As Variant arrSQLServerDataTypes = Array("INT", "varchar(50)", "Date", "Decimal", "Char(1)", "varchar(4)", "bit", "Decimal") strSQLFile = mstrPath & Chr(92) & mstrFileName & "_SQL.txt" Set fso = New FileSystemObject Set ts = fso.CreateTextFile(strSQLFile, True) strSQL = "CREATE TABLE " & mstrSQLTable & "( " intTypeCnt = LBound(arrSQLServerDataTypes) For intFieldCnt = 1 To mintMaxFields DoEvents strSQL = strSQL & IIf(intFieldCnt = 1, Empty, ",") & _ CSTR_COLUMN_NAME_PREFIX & intFieldCnt & vbTab & arrSQLServerDataTypes(intFieldCnt) intTypeCnt = intTypeCnt + 1 If intTypeCnt > UBound(arrSQLServerDataTypes) Then intTypeCnt = LBound(arrSQLServerDataTypes) + 1 Next strSQL = strSQL & " )" CreateSQLFile = True EXIT_HERE: ts.WriteLine (strSQL) ts.Close Set ts = Nothing Set fso = Nothing Exit Function ERR_HANDLER: CreateSQLFile = False GoTo EXIT_HERE End Function Private Function PickRandomFromArray(ByVal vntArray) As Variant Dim intMax As Integer Dim intMin As Integer intMax = UBound(vntArray) intMin = LBound(vntArray) PickRandomFromArray = vntArray(GetRandomNumber(intMax, intMin)) End Function Private Function GetRandomString(ByVal intMaxLength As Integer, _ Optional ByVal blnFixedLength As Boolean = False, _ Optional ByVal blnAllowNulls As Boolean = False, _ Optional ByVal dblNullChance As Double = 0.5) As String Dim intLen As Integer Dim dblNull As Double If blnAllowNulls = True Then dblNull = GetRandomNumber(1, 0, 2) If dblNull <= dblNullChance Then GetRandomString = Empty Else If blnFixedLength Then intLen = intMaxLength Else intLen = GetRandomNumber(intMaxLength, 1) GetRandomString = BuildCharacterString(intLen) End If Else If blnFixedLength Then intLen = intMaxLength Else intLen = GetRandomNumber(intMaxLength, 1) GetRandomString = BuildCharacterString(intLen) End If End Function Private Function BuildCharacterString(ByVal intLength) As String Dim strNewString As String Dim intCnt As Integer For intCnt = 1 To intLength strNewString = strNewString & Chr(GetRandomNumber(CINT_MAX_ASCII, CINT_MIN_ASCII)) Next BuildCharacterString = strNewString End Function Private Function GetRandomDate(Optional ByVal blnAsString As Boolean = True) As Variant Dim intYear As Integer Dim intMonth As Integer Dim intDay As Integer Dim intMaxDay As Integer intYear = GetRandomNumber(Year(Now()), 1930) intMonth = GetRandomNumber(12, 1) Select Case intMonth Case 2 intMaxDay = 28 Case 9, 4, 6, 11 intMaxDay = 30 Case Else intMaxDay = 31 End Select intDay = GetRandomNumber(intMaxDay, 1) If blnAsString Then GetRandomDate = CStr(intYear & "-" & intMonth & "-" & intMaxDay) Else GetRandomDate = CDate(intMaxDay & "/" & intMonth & "/" & intYear) End If End Function Private Function GetRandomNumber(ByVal lngMax As Long, ByVal lngMin As Long, Optional ByVal intDecimals As Integer) If IsMissing(intDecimals) Or intDecimals = 0 Then Randomize GetRandomNumber = Int((lngMax + 1 - lngMin) * Rnd + lngMin) Else Randomize GetRandomNumber = Round((lngMax - lngMin) * Rnd + lngMin, intDecimals) End If End Function |
How to use the class
So in the example code below, I am using the class to create a comma delimited text file that has 25 rows and 12 columns called “Test_YYYYMMDD.csv” which will be saved in the same location as my macro workbook:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
Option Explicit Public Sub CreateDummyFile() Dim oTxt As New clsTextFileGenerator oTxt.Delimiter = "," oTxt.FieldCount = 12 oTxt.RowCount = 25 oTxt.IncludeHeader = True oTxt.FileType = ".csv" oTxt.FileNameDateStamp = True oTxt.Filename = "Test" If oTxt.GenerateTextFile Then If oTxt.CreateSQLFile Then MsgBox "File has been created!" End If Else MsgBox "File not created!" End If Set oTxt = Nothing End Sub |
Output
This is what the dummy CSV file will look like:
In addition to this, a second text file is generated containing the required SQL needed to create a table in SQL Server to store the file:
Hopefully, you can use this class and the steps outlined here to create dummy test files for your own projects!
Thank you for reading this post. Please take time to read the disclaimer about content found on this site.
Share :
