Option Explicit 
Const Direct = "C:\VBAFiles\" 'full path to files
Const CsvFile = "A22.csv" 
Const DataBase = "A22.mdb" ' this needs to be a valid database
Const NewTabelName = "A22Gusting" 
Sub Main() 
    Dim i As Integer 
    Dim mMyData() As String 
    Dim mRow As Integer 
    Dim mColumn As Integer 
    Dim mClearIt As String 
    If Not CheckForDirectory Then Exit Sub 
    mClearIt = Chr(13) & Chr(7) ' the carriage return and end of cell marker
    For i = 1 To ThisDocument.Tables.Count 
        mRow = ThisDocument.Tables(i).Rows.Count 
        mColumn = ThisDocument.Tables(i).Columns.Count 
         ' this will get all text from the table and split each cell into a variable array
         ' it will create an extra "column" of information this is because there will be 2 carriage return and end of cell marker
        mMyData = Split(ThisDocument.Tables(i).Range.Text, mClearIt) 
        WriteCSV mMyData, mColumn, i 
    Next 
End Sub 
 
Sub WriteCSV(WrtData() As String, ColCnt As Integer, BKcntr As Integer) 
    Dim i As Integer 
    Dim HldStr As String 
    Dim cntr As Long 
    Open Direct & CsvFile For Output As #1 
    For i = LBound(WrtData) To UBound(WrtData) Step ColCnt + 1 
        If i < UBound(WrtData) Then 
             'build string that will be written to a file
            For cntr = 0 To ColCnt + 1 
                If cntr = 0 Then 
                    HldStr = Chr(34) & CStr(i / (ColCnt + 1)) & Chr(34) & "," 
                Else 
                    HldStr = HldStr & Chr(34) & WrtData(i + cntr - 1) & Chr(34) & "," 
                End If 
            Next 
             'write the file
            Print #1, Left(HldStr, Len(HldStr) - 4) 
            HldStr = vbNullString 
        End If 
    Next 
    Close #1 
    ImportToAccess Direct & CsvFile, BKcntr 
End Sub 
Sub ImportToAccess(iFile As String, i As Integer) 
    Dim DB As New Access.Application 
    On Error GoTo NoDB 
     'open database
    DB.OpenCurrentDatabase Direct & DataBase 
     'import csv file to a new table
    DB.DoCmd.TransferText acImportDelim, , NewTabelName & CStr(i), iFile, False 
     'close database
    DB.CloseCurrentDatabase 
    Set DB = Nothing 
    On Error GoTo 0 
    Exit Sub 
NoDB: 
    If Err.Number = 7866 Then 'means database is not there
        Err.Clear 
        DB.NewCurrentDatabase Direct & DataBase 
        Resume Next 
    Else 
        MsgBox "An Unknown Error has occured!" & Err.Description 'don't know what happened - best to stop
        Err.Clear 
        End 
    End If 
End Sub 
Function CheckForDirectory() 
    Dim IsThere As String 
    On Error GoTo Gone 
    CheckForDirectory = False 
    IsThere = Dir(Direct & "*.*", vbDirectory) 
    If IsThere = vbNullString Then 
        MkDir Left(Direct, Len(Direct) - 1) 
        CheckForDirectory = True 
    Else 
        CheckForDirectory = True 
    End If 
    On Error GoTo 0 
    Exit Function 
Gone: 
    MsgBox "An Error has occured With the Directory. Most probabal cause - Directory Does Not Exist - Cannot be created." 
    On Error GoTo 0 
    Err.Clear 
End Function