Ordinare File Txt

[OscarPartecipante Oscar Karma: 45 pts]

Salve il mio problema che la macro funziona benissimo , ma mi salva i File in formato File anzi che in documento di testo 

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
 Dim MyFile As String
      Dim percorso As String
      Dim FileTesto As String
      
      percorso = ActiveWorkbook.Path
      MyFile = Dir(percorso & "\*.txt")

      Do While MyFile <> ""
         FileTesto = percorso & "\" & MyFile
        'MsgBox FileTesto
         Call ImpFilesTesto(FileTesto)
         MyFile = Dir()
         
         
FileTesto = Mid(FileTesto, 44, 7)

'------------------------------Scompatto il File
riga = Cells(Rows.Count, 1).End(xlUp).Row
     Range("a1", "a" & riga).Select
     Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
        TrailingMinusNumbers:=True
        Range("A1").Select
'------------------------------------------------------------------------------Ordino il foglio
   Dim Colonna, Col As Variant
      Colonna = Cells(1, Columns.Count).End(xlToLeft).Column
   If Colonna = 1 Then: Col = "A"
   If Colonna = 2 Then: Col = "B"
   If Colonna = 3 Then: Col = "C"
   If Colonna = 4 Then: Col = "D"
   If Colonna = 5 Then: Col = "E"
   If Colonna = 6 Then: Col = "F"
   If Colonna = 7 Then: Col = "G"
   If Colonna = 8 Then: Col = "H"
   If Colonna = 9 Then: Col = "I"
   If Colonna = 10 Then: Col = "J"
        ActiveWorkbook.Worksheets("Dati").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Dati").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dati").Sort
        .SetRange Range("A1", Col & riga)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


'------------------------------Salvo il File in un'altra cartella
ChDir "C:\Prova\"
Dim Y, i As Integer
Colonna = 10
riga = WorksheetFunction.CountA(Foglio1.Range("A:A"))

Open FileTesto For Output As #1
For Y = 1 To riga
For i = 1 To Colonna
valore = Cells(Y, i).Value
If i = Colonna Then
valore = valore & vbCrLf
Else
valore = valore & " "
End If
Print #1, valore;
Next i
Next Y
Close #1
'------------------------------Fine salvataggio
Loop
End Sub

Sub ImpFilesTesto(FileTesto As String)
DoEvents
 Range("A:A") = ""
    Dim nRiga As Long, nvo As Integer, nv As Integer
    Dim nCol As Integer, Testo As String, riga As String
    Range("A:J") = ""
    Sheets("dati").Select
        Open FileTesto For Input As #1
        nRiga = Range("A65000").End(xlUp).Row
        If nRiga = 1 Then
           nRiga = 0
        Else
           nRiga = 1 'nRiga + 1
        End If
leggiAncora:
        nRiga = nRiga + 1
        If Not EOF(1) Then
            Line Input #1, riga
            nvo = 0: nCt = Len(riga): nCol = 0
scanTesto:
            nCol = nCol + 1
            nv = InStr(nvo + 1, riga, ",")
            If nv = 0 Then
              Testo = Right(riga$, nCt - nvo)
              Cells(nRiga, nCol) = Testo$
              GoTo leggiAncora
            End If
            Testo = Mid(riga$, nvo + 1, (nv - 1) - nvo)
            nvo = nv
            Cells(nRiga, nCol) = Testo
            GoTo scanTesto
        End If
    Close #1
   
End Sub

[patelModeratore patel Karma: 51 pts]

Potresti spiegare cosa vuoi ottenere ? la macro è frutto di una discussione precedente ?

[OscarPartecipante Oscar Karma: 45 pts]

Ciao patel  

la parte dove salva il File lo salva benissimo il problema è che viene salvato come (File) e invece mi vuole come (Documento di testo)

Nell'allegato puoi vedere il primo è come me lo salva il secondo è come dovrebbe essere

Allegati:

You must be logged in to view attached files.

[OscarPartecipante Oscar Karma: 45 pts]

Patel ho risolto  mi è bastato modificare questa riga  grazie per il tuo intervento sei sempre gentilissimo 

FileTesto = Mid(FileTesto, 44, 7) & ".txt"

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Volevo dirlo io, che il problema era che mancava l'estensione, ma poi avevo visto solo

MyFile = Dir(percorso & "\*.txt")
FileTesto = percorso & "\" & MyFile

e quindi evidentemente l'estensione c'era. Sono stato a pensarci un po' poi ho fatto altro.

Mi era sfuggita purtroppo  l'istruzione successiva:

FileTesto = Mid(FileTesto, 44, 7)

Altrimenti sollevavo subito l'osservazione.

Questa riga comunque è un errore concettuale enorme quando il nome del file txt selezionato ha una lunghezza diversa da quella prestabilita; tu vuoi recuperare solo il nome del file a partire dall'ultimo slash? la strada da percorrere è un'altra. Usa InstrRev.

[OscarPartecipante Oscar Karma: 45 pts]

Si in effetti prima  avevo fatto la seguente modifica , ma poi spostando la cartella non andava più quindi sono passato alla successiva

FileTesto = Mid(FileTesto, 40, 7) & ".txt" 

la seconda in qualunque posizione si trovi va sempre bene h'hè prima non ci avevo proprio pensato 
grazie vecchio frac

FileTesto = Right(FileTesto, 11)

[Autore]

Articoli