VBA for Access not creating a table correctly-CodePudding

New VBA writer here.

I've managed to Frankenstein some code together to allow me to create a group of tables based off of .csv's inside of a folder. I wanted each of them to be a separate table so most of the concat post around weren't for me. Here's what I've come up with so far:

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's been working surprisingly well. Until the last section where I use TransferText to create the actual 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 a completely empty table with no data, 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.

Sorry if the post is too long and wordy. I'm not sure what else I can try to get all the data into the table. 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? If you have suggestions on how I can shorten some of the code that would be appreciated as well.

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

CodePudding user response：

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.