ho scritto questo codice….
Public Sub ImportaTxtFile(FName As String, Sep As String)
Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
Dim n As Integer
Application.ScreenUpdating = False
'On Error GoTo EndMacro:
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row
Open FName For Input Access Read As #1
While Not EOF(1)
Line Input #1, WholeLine
If Sheets("Tracciato").Cells(2, 6).Value > 0 Then
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
End If
ColNdx = SaveColNdx
Pos = 1
n = 1
' NextPos = InStr(Pos, WholeLine, Sep)
NextPos = Sheets("Tracciato").Cells(1, 1).Value
While NextPos >= 1
If n = 1 Then
TempVal = Mid(WholeLine, 1, NextPos)
Cells(RowNdx, ColNdx).Value = TempVal
n = n + 1
Pos = NextPos
ColNdx = ColNdx + 1
'NextPos = InStr(Pos, WholeLine, Sep)
NextPos = Sheets("Tracciato").Cells(n, 1).Value
Else
TempVal = Mid(WholeLine, Pos + Len(Sep) + 1, NextPos - Pos - Len(Sep))
Cells(RowNdx, ColNdx).Value = TempVal
n = n + 1
Pos = NextPos
ColNdx = ColNdx + 1
'NextPos = InStr(Pos, WholeLine, Sep)
NextPos = Sheets("Tracciato").Cells(n, 1).Value
End If
Wend
RowNdx = RowNdx + 1
Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Fine Importazione Txt File
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Scegli file Txt e carattere di separazione
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub finestraImportazione()
Dim FileName As Variant
Dim Sep As String
FileName = Application.GetOpenFilename(FileFilter:="Text File (*.txt),*.txt")
If FileName = False Then
'lascia perdere
Exit Sub
End If
Sep = Application.InputBox("Inserisci il carattere di separazione, se presente:", Type:=2)
If Sep = vbNullString Then
End If
' controllo se esiste un carattere di separazione e valorizza il foglio 2 cella f2
If CInt(Len(Sep)) = 0 Then
Cells(2, 6).Value = 0
Else
Cells(2, 6).Value = Len(Sep)
End If
Debug.Print "FileName: " & FileName, "Separatore: " & Sep
ImportaTxtFile FName:=CStr(FileName), Sep:=CStr(Sep)
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Fine finestra scelta file e specificazione separatore
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''