nome file

Hai un problema con Excel?

Nuova discussione

nome file
di gio (utente non iscritto) data: 12/10/2012 15:29:08
qua chiedo direttametne a voi come si fa perchè non ne ho la minima idea di dove mettere le mani..

questo codice importa tutti i file con estensione DMO e DMO_CAPT in un unico foglio excel per poi rielaborare i dati...

a me servirebbe leggere il nome di ciasciun file che importa...

come si fa?

    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    If fd.Show = 0 Then Exit Sub
    mia_cartella = fd.SelectedItems(1)
    
    Sheets("foglio1").Select
    
    Set ff = CreateObject("Scripting.FileSystemObject").GetFolder(mia_cartella).Files
 
    For Each f In ff
        If Right(f, 9) = ".DMO_CAPT" Or Right(f, 4) = ".DMO" Then
            With ActiveSheet.QueryTables.Add(Connection:="text;" & f, Destination:=[a1])
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 1252
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = True
                .TextFileTabDelimiter = True
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = True
                .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
            End With
        End If
    Next

di gio (utente non iscritto) data: 12/10/2012 15:48:50
i primi programmi che facevo usavo queste funzioni per importare i file..e qui riuscirei a estrarre il nome attraverso la variabile sPathNome..però questa seleziona il singolo file da importare...a me invece serve che selezioni tutti i file della cartella in automatico..per cui non posso usarla..

nella funzione che ho inserito nel primo post [che ho brutalmente copiato da qualche parte o forse mi aveva nace suggerito qualcuno di voi] è possibile fare lo stesso?

  Dim sPathNome As Variant
        sPathNome = Application.GetOpenFilename( _
        "File di testo (*.txt),*.txt", _
        , "Selezionare un report")

    If sPathNome <> False Then
       With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & sPathNome, Destination:=Range("A1"))

di Vecchio Frac data: 12/10/2012 16:05:38
Eh già, quel codice l'avevamo suggerito Noi (nota il Noi maiestatico ^_^).
Ad ogni passaggio del ciclo For Each nella variabile "f" viene depositato un riferimento al file.
Con If Right(f, 9) = ".DMO_CAPT" tu processi solo quelli la cui estensione è "DMO_CAPT".

Quindi in "f" trovi le informazioni che cerchi:
- f.Name è il nome del file attualmente in esame (es. test.DMO_CAPT)
- f.Path è il nome completo del file in esame, con il percorso assoluto (es. C:Pippo est.DMO_CAPT)

Al limite ti basta un Cstr(f), ma questo equivale a f.Path perciò ti sporca il nome del file con tutto il percorso dove il file si trova.
di gio (utente non iscritto) data: 12/10/2012 16:23:41
wow stra efficiente...
adesso però è finita la settimana..lunedì mattina alle 8 partirò da quei 2 comandi e vedo se riesco a combinare qualcosa..

byebye buon weekend forum!
di Vecchio Frac data: 12/10/2012 16:32:55
LOL... arrivederci e buon fine settimana a te ^_^

di gio (utente non iscritto) data: 15/10/2012 10:17:01
fantastico sembra funzionare!

c'è solo un problema..
queste poche righe di codice qui sotto leggono i nomi dei file [li legge mentre li importa] e me li scrivono in un certo ordine [sembrerebbe quello in cui li trova nella cartella] direttamente nel foglio dove metto i risultati...ma quando poi importo i file e li elaboro me li ritrovo nell'ordine opposto..come mai?

ps:esiste una funzione che da una stringa ad esempio "abc123" riesce a estrarmi solo "123" in automatico?

 v = Split(f.Name, "_")
                Sheets("eCAV").Cells(i, 4) = Left(v(3), 5)  'numero report
                Sheets("eCAV").Cells(i, 3) = v(1)           'np
                Sheets("eCAV").Cells(i, 2) = v(0)           'codice
                i = i + 1

di Vecchio Frac data: 15/10/2012 11:59:24
cit. " me li ritrovo nell'ordine opposto..come mai? "
--> non dipende da te ma da come sono stati memorizzati nella tabella file (FAT) del sistema operativo, il FileSystemObject li recupera a modo suo. Quando importi i file e li elabori devi indicare un criterio di elaborazione, che sinceramente adesso non saprei dirti come :)

cit. " ps:esiste una funzione che da una stringa ad esempio "abc123" riesce a estrarmi solo "123" in automatico? "
--> Non esiste, la devi costruire processando tutti i caratteri di una stringa ed estraendo solo quelli numerici. Oppure usi una regular expression.

di HarryBosch data: 15/10/2012 12:46:17
Ti suggerisco un metodo che, come appena detto da VecchioFrac, processa tutta la stringa ottenendo solo i caratteri numerici. L'avevo inserita qualche giorno fa come funzione, in altro thread con richiesta simile.

Sub solo_numeri()
Dim num As Variant
s = "MiaStringa123"
    For i = 1 To Len(r)
        If IsNumeric(Mid(s, i, 1)) Then
            num = num + Mid(s, i, 1)
        End If
    Next
MsgBox "Il numero inserito nella stringa é " & num
End Sub

di gio (utente non iscritto) data: 15/10/2012 16:43:05
grande harry..funzione perfetta!

resta il problema dell'ordine..consigli?
di HarryBosch data: 15/10/2012 16:58:51
e quale sarebbe l'ordine che ti interessa?
Una volta ricavati i nomi dei file, vuoi ordinarli in base al numero ricavato dalla stringa, dal minore al maggiore?
di gio (utente non iscritto) data: 16/10/2012 08:37:19
l'ordine sarebbe esattamente al contrario

di Vecchio Frac data: 16/10/2012 09:40:52
L'ordinamento lo puoi ottenere con una tabella di appoggio; prima scorri tutti i nomi di file presenti nella directory che ti interessa, li salvi in un array, riordini l'array, quindi avvi la routine principale che legge di nuovo tutti i file, ma questa volta pescando i nomi dei file dall'array riordinato.

Aggiungo due functions ulteriori per estrarre i numeri da una stringa, la prima restituisce una collection e gioca con le "espressioni regolari", la seconda lavora con Like.
Così, tanto per allungare il thread ^_^

Function estrai_numeri(s As String) As Collection
'restituisce una collection di numeri
'utilizzo:
'Set new_collection = estrai_numeri(stringa)
'poi si può ciclare in new_colelction per recuperare i valori memorizzati

Dim re As Object, ma As Object, v As Collection

    Set re = CreateObject("VBScript.Regexp")
    Set v = New Collection
    re.Pattern = "d+"
    re.Global = True
    re.ignorecase = True
    For Each ma In re.Execute(s)
        v.Add ma
    Next
    Set estrai_numeri = v
End Function


Function estrai_numeri(ByVal source As String) As Long
'conserva solo i caratteri numerici; sostituisce tutti gli altri caratteri non alfabetici con ""
'utilizzo:
'i = estrai_numeri(stringa)

Dim i As Long, t As String, s As String

    s = source
    For i = 1 To Len(s)
        t = Mid(s, i, 1)
        If t Like "*[!0-9]*" Then source = Replace(source, t, "")
    Next
    estrai_numeri = CLng(source)
End Function

di gio (utente non iscritto) data: 16/10/2012 09:52:35
mmm avevo pensato alla stringa d'appoggio..però non saprei come riordinarla al contrario..xd
di Vecchio Frac data: 16/10/2012 11:05:18
Problema interessante, io lo risolverei velocemente creando un foglio temporaneo, incollando in A:A, cella dopo cella, i diversi nomi, eseguendo poi un Sort discendente sul range A:A. Al termine puoi riportare iin memoria il range ed eliminare il foglio temporaneo. Quindi processare i file seguendo l'ordine dell'array in memoria.
In alternativa, fare tutto in memoria con un array da riordinare con uno dei tanti metodi di ordinamento (ad esempio il Quicksort).

p.s. non ho detto astrusità impossibili da realizzare... magari un po' di tempo per pensarci ci vuole :)
di gio (utente non iscritto) data: 17/10/2012 08:53:25
non ho trovato niente su come si usa un sort per invertire un vettore..
ho trovato la funzione REVERSE ma vale per le stringhe..

di Vecchio Frac data: 17/10/2012 11:10:13
Intendi invertire un vettore del tipo
vett = ["a", "b", "c", "d"] --> ["d", "c", "b", "a"] ?

Sub inverti_vettore(vector() As String)
Dim i As Long, maximum As Long, minimum As Long, tmp As String
    
    minimum = LBound(vector)
    maximum = UBound(vector)
    For i = minimum To minimum + (maximum - minimum)  2
        tmp = vector(i)
        vector(i) = vector(maximum + minimum - i)
        vector(maximum + minimum - i) = tmp
    Next
End Sub

di HarryBosch data: 17/10/2012 11:13:48
Ok, piccolo aiutino. Supponiamo che il tuo array, costituito dai nomi dei fogli, si chiami lista().
Ora, fai passare l'array per questo ciclo e vedi come si è modificato al termine.

For i = UBound(lista) - 1 To 1 Step -1
        For j = 1 To i
            'per ordinare dal maggiore inverti con "<"
            If lista(j) > lista(j + 1) Then
                Temp = lista(j)
                lista(j) = lista(j + 1)
                lista(j + 1) = Temp
            End If
        Next j
    Next i

di Vecchio Frac data: 17/10/2012 11:25:56
@Vanni
piccola correzione, scusami :)

*non*
For i = UBound(lista) - 1 To 1 Step -1
For j = 1 To i

*ma*
For i = UBound(lista) - 1 To LBound(lista) + 1 Step -1
For j = LBound(lista) To i

altrimenti l'eventuale vettore in base zero (come nelle mie prove) si "perde" l'elemento zero.
Così invece lo rendi generico.
In pratica swappi l'ultimo elemento con il primo, il penultimo col secondo ecc., quindi devi per forza tener conto anche dell'elemento zero :)
di HarryBosch data: 17/10/2012 11:45:10
@ VecchioFrac
hai ragione! Ottima osservazione! spesso infatti salto l'elemento 0 per mia comodità, inserendo l'Option Base a 1. Nel copiare il mio esempio dagli appunti non avevo tenuto conto di questa cosa :)

di gio (utente non iscritto) data: 17/10/2012 12:14:54
permettetemi di riproporvi la mia stupida versione di questo problema

magari non funzionerà mai [è un po troppo ottimista come soluzione]
però provo...per adesso mi da errore qua...mi dice indice non incluso nell'intervallo
vett(k) = num

io volevo mettere man mano che scorreva il ciclo i valori di num in una posizione sempre crescente del vettore [k=k+1]..
e quando poi li richiamo faccio scorrere il vettore al contrario [k=k-1]
troppo semplice per funzionare?

   v = Split(f.Name, "_")
                num = ""
                k = 1
                For t = 1 To Len(v(3))      'estrae numeri da stringa
                  If IsNumeric(Mid(v(3), t, 1)) Then
                   num = num + Mid(v(3), t, 1)
                   vett(k) = num
                   k = k + 1
                  End If
                Next
                
                Sheets("eCAV").Cells(i, 4) = vett(k)            'numero report
                Sheets("eCAV").Cells(i, 2) = v(0)           'codice
                If v(2) Like "NP*" Then
                Sheets("eCAV").Cells(i, 3) = v(2)           'np
                Else
                Sheets("eCAV").Cells(i, 3) = v(1)
                End If
                k = k - 1
                
                i = i + 1

di gio (utente non iscritto) data: 17/10/2012 12:28:53
forse un primo errore l'ho trovato..
il codice che ho messo io [al di là dell'errore di sintassi da qualche parte chen on so]mette in un vettore i pezzi della stringa v(3)...non i risultati del ciclo come servirebbe a me...

detto ciò però non so come correggere xd

di gio (utente non iscritto) data: 17/10/2012 12:48:31
che ne dite?

    i = 25
    Set ff = CreateObject("Scripting.FileSystemObject").GetFolder(mia_cartella).Files
    
    For Each f In ff
            If UCase(Right(f, 9)) = ".DMO_CAPT" Or UCase(Right(f, 4)) = ".DMO" Then
            With ActiveSheet.QueryTables.Add(Connection:="text;" & f, Destination:=[a1])
                .Name = "SOM59054_NP2216552_BFA_REP1_1"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 1252
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = True
                .TextFileTabDelimiter = True
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = True
                .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
                
              Dim vett() As String
              
                'On Error GoTo asd
                v = Split(f.Name, "_")
                num = ""
                k = 1
                For t = 1 To Len(v(3))      'estrae numeri da stringa
                  If IsNumeric(Mid(v(3), t, 1)) Then
                   num = num + Mid(v(3), t, 1)
                   
                  
                  End If
                Next
                vett(k) = num                'inserisce numeri nel vettore
                k = k + 1
               
                
                Sheets("eCAV").Cells(i, 2) = v(0)           'codice
                If v(2) Like "NP*" Then
                Sheets("eCAV").Cells(i, 3) = v(2)           'np
                Else
                Sheets("eCAV").Cells(i, 3) = v(1)
                End If
                'k = k - 1
                
                i = i + 1
'asd:
            End With
        End If
    Next
    
    i = 25
    For k = 10 To 1 Step -1    'inserisce il vettore nel foglio dei risltati facendolo scorrere 
                                        'al contrario
     Sheets("eCAV").Cells(i, 4) = vett(k)
     i = i + 1
     Next

di gio (utente non iscritto) data: 18/10/2012 11:16:49
risolto...
ho usato una colonna in un foglio di appoggio e ho riportato i valori prendendoli dal fondo..
grazie del consiglio

Vuoi Approfondire?