Creating a table using VBA for Access - vba

Question

I managed code to create a group of tables based off of .csv files inside of a folder.
I want each of them to be a separate table so most of the concatenation posts weren't for me.
Public Function importExcelSheets(Directory As String) As Long
On Error Resume Next
Dim strDir As String
Dim strFile As String
Dim I As Long
Dim N As Long
Dim FSO As Object, MyFile As Object
Dim FileName As String, Arr As Variant
Dim Content As String
Dim objStreamIn
Dim objStreamOut
'Prepare Table names-------------------------------------------------------------------------------------
FileName = "path/to/table/names.txt"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set MyFile = FSO.OpenTextFile(FileName, 1)
Arr = Split(MyFile.ReadAll, vbNewLine)
'Verify Directory and pull a file------------------------------------------------------------------------
If Left(Directory, 1) <> "\" Then
strDir = Directory & "\"
Else
strDir = Directory
End If
strFile = Dir(strDir & "*.csv")
'Fill Tables----------------------------------------------------------------------------------------------
I = UBound(Arr) - 1
While strFile <> ""
strFile = strDir & strFile
Set objStreamIn = CreateObject("ADODB.Stream")
Set objStreamOut = CreateObject("ADODB.Stream")
objStreamIn.Charset = "utf-8"
objStreamOut.Charset = "utf-8"
objStreamIn.Open
objStreamOut.Open
objStreamIn.LoadFromFile (strFile)
objStreamOut.Open
N = 1
While Not objStreamIn.EOS
Content = objStreamIn.ReadText(-2)
If N = 1 Then
Content = Replace(Content, "/", vbNullString, , 1)
objStreamOut.WriteText Content & vbCrLf
Else
objStreamOut.WriteText Content & vbCrLf
End If
N = N + 1
Wend
objStreamOut.SaveToFile strFile, 2
objStreamIn.Close
objStreamOut.Close
Set objStreamIn = Nothing
Set objStreamOut = Nothing
DoCmd.TransferText _
TransferType:=acImportDelim, _
TableName:=Arr(I), _
FileName:=strFile, _
HasFieldNames:=True, _
CodePage:=65001
strFile = Dir()
I = I - 1
Wend
importExcelSheets = I
End Function
It works until the last section where I use TransferText to create the table.
It will get different results based on a few things I've tried:
Running the script after commenting out the entire objStream section gives me the data and table names, but the headers are [empty], "F2", "F3", ... "F27".
I suspected it was because there was a forward slash in the first column header, so I put in the Replace() to remove it.
Running the script as in above gives me an empty table.
I now suspect that the encoding header of the file is the reason for this.
Running the script after changing objStreamOut.Charset = "utf-8" to objStreamOut.Charset = "us-ascii" and updating the CodePage to 20127 gives me an empty table with black diamond question marks for a column header.
I want to blame the encoding characters but it ran one time almost flawlessly with the utf-8 encoding and CodePage 65001. Is there another way around this?
Here is the Byte Order Mark of the file showing the UTF-8 Encoding
Edit: changed CodeType to CodePage and added vbCrLf to append to Content
Edit: Included picture of Hex for files showing UTF-8 offest

Answer 1

With the help from Comments it looks like I got it to work after fixing the vbCrLf problem. I switched the objStreamOut charset to us-ascii and changed the CodePage to 20127 to reflect that as well. I now have headers, table names, and data working normally. Here is the final code:
Public Function importExcelSheets(Directory As String) As Long
On Error Resume Next
Dim strDir As String
Dim strFile As String
Dim I As Long
Dim N As Long
Dim FSO As Object, MyFile As Object
Dim FileName As String, Arr As Variant
Dim Content As String
Dim objStreamIn
Dim objStreamOut
'Prepare Table names-------------------------------------------------------------------------------------
FileName = "path/to/table/names.txt"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set MyFile = FSO.OpenTextFile(FileName, 1)
Arr = Split(MyFile.ReadAll, vbNewLine)
'Verify Directory and pull a file------------------------------------------------------------------------
If Left(Directory, 1) <> "\" Then
strDir = Directory & "\"
Else
strDir = Directory
End If
strFile = Dir(strDir & "*.csv")
'Fill Tables----------------------------------------------------------------------------------------------
I = UBound(Arr) - 1
While strFile <> ""
strFile = strDir & strFile
Set objStreamIn = CreateObject("ADODB.Stream")
Set objStreamOut = CreateObject("ADODB.Stream")
objStreamIn.Charset = "utf-8"
objStreamOut.Charset = "us-ascii"
objStreamIn.Open
objStreamOut.Open
objStreamIn.LoadFromFile (strFile)
objStreamOut.Open
N = 1
While Not objStreamIn.EOS
Content = objStreamIn.ReadText(-2)
If N = 1 Then
Content = Replace(Content, "/", vbNullString, , 1)
objStreamOut.WriteText Content & vbCrLf
Else
objStreamOut.WriteText Content & vbCrLf
End If
N = N + 1
Wend
objStreamOut.SaveToFile strFile, 2
objStreamIn.Close
objStreamOut.Close
Set objStreamIn = Nothing
Set objStreamOut = Nothing
DoCmd.TransferText _
TransferType:=acImportDelim, _
TableName:=Arr(I), _
FileName:=strFile, _
HasFieldNames:=True, _
CodePage:=20127
strFile = Dir()
I = I - 1
Wend
importExcelSheets = I
End Function
Still not entirely sure why VBA was not getting the correct data when I used utf-8 and 65001 for CodeType and works now for us-ascii. This will work for me however.