modificar código para subir múltiples archivos txt

Hola buenas Tardes tengo este codigo y solo me funciona para poder seleccionar un archivo TXT, y cargarlo a una tabla en sql server ,

Me gustaria poder seleccionar varios archivos txt y poder insertarlos a la misma tabla este es el codigo que uso donde podria modificar.

Public Function ImportTextFile(cnn As Object, _
  ByVal tblName As String, _
  Optional FieldDelimiter As String = "|", _
  Optional RecordDelimiter As String = vbCrLf) As Boolean

Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim sFileContents As String
Dim iFileNum As Long
Dim sTableSplit() As String
Dim sRecordSplit() As String
Dim lCtr As Long
Dim iCtr As Long
Dim iFieldCtr As Long
Dim lRecordCount As Long
Dim iFieldsToImport As Long
Dim asFieldNames() As String
Dim abFieldIsString() As Boolean
Dim iFieldCount As Long
Dim sSQL As String
Dim bQuote As Boolean
Dim fn As Variant

On Error GoTo errHandler
If Not TypeOf cnn Is ADODB.Connection Then Exit Function
If cnn.State <> adStateOpen Then Exit Function
    WB_1 = ThisWorkbook.Name
#If Mac Then
    FileFullPath = MacScript("(choose file) as string")
#Else
  With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        If .Show = -1 Then FileFullPath = .SelectedItems(1)
    End With
      
    
#End If
    If FileFullPath = Empty Then
        ans = MsgBox("No se Escogio Archivo!", vbCritical, "Error")
        Exit Function
    End If


If cnn.State = 0 Then cnn.Open
Set cmd.ActiveConnection = cnn
cmd.CommandText = tblName
cmd.CommandType = adCmdTable
Set rs = cmd.Execute
iFieldCount = rs.Fields.Count
rs.Close

ReDim asFieldNames(iFieldCount - 1) As String
ReDim abFieldIsString(iFieldCount - 1) As Boolean

For iCtr = 0 To iFieldCount - 1
    asFieldNames(iCtr) = "[" & rs.Fields(iCtr).Name & "]"
    abFieldIsString(iCtr) = FieldIsString(rs.Fields(iCtr))
Next
    

iFileNum = FreeFile
Open FileFullPath For Input As #iFileNum
sFileContents = Input(LOF(iFileNum), #iFileNum)
Close #iFileNum
'split file contents into rows
sTableSplit = Split(sFileContents, RecordDelimiter)
lRecordCount = UBound(sTableSplit)

For lCtr = 0 To lRecordCount - 1
        'split record into field values
    
    sRecordSplit = Split(sTableSplit(lCtr + 1), FieldDelimiter)
    iFieldsToImport = IIf(UBound(sRecordSplit) + 1 < _
        iFieldCount, UBound(sRecordSplit) + 1, iFieldCount)
 
   'construct sql
    sSQL = "INSERT INTO " & tblName & " ("
    
    For iCtr = 0 To iFieldsToImport - 1
        bQuote = abFieldIsString(iCtr)
        sSQL = sSQL & asFieldNames(iCtr)
        If iCtr < iFieldsToImport - 1 Then sSQL = sSQL & ","
    Next iCtr
    
    sSQL = sSQL & ") VALUES ("
    
    For iCtr = 0 To iFieldsToImport - 1
        If abFieldIsString(iCtr) Then
             sSQL = sSQL & prepStringForSQL(sRecordSplit(iCtr))
        Else
            sSQL = sSQL & sRecordSplit(iCtr)
        End If
        
        If iCtr < iFieldsToImport - 1 Then sSQL = sSQL & ","
    Next iCtr
    sSQL = sSQL & ")"
    cnn.Execute sSQL
   

Next lCtr

rs.Close
Close #iFileNum
Set rs = Nothing
Set cmd = Nothing
ImportTextFile = True
Exit Function
errHandler:
On Error Resume Next
If iFileNum > 0 Then Close #iFileNum
If rs.State <> 0 Then rs.Close
Set rs = Nothing
Set cmd = Nothing
End Function

agradezco de antemano su apoyo.