Estrapolazione dati dai nomi dei files di alcune cartelle

[Final Job]

Buongiorno.

Ho una Cartella con, al suo interno, più sottocartelle contenenti files
che sono nominaticon:
- un prefisso alfanumerico
- un testo in mezzo
- un suffisso finale.

Avrei bisogno di listare questi contenuti e di incolonnare in un foglio
excel le seguenti informazioni di ogni sottocartella:

nella prima colonna --> il prefisso. I caratteri del nome file, cioè,
che vanno dal primo, eventuale spazio iniziale escluso, fino al primo
spazio del nome (spazio escluso).

nella seconda colonna --> tutto il testo che va dal primo spazio
all'ultimo spazio (spazi esclusi)

nella terza colonna --> il suffisso (che corrisponde ai caratteri che
vanno dall'ultimo spazio del nome, spazio escluso, fino all'ultimo
carattere del nome (carattere incluso).

nella quarta colonna --> il percorso della cartella che contiene il nome
dal quale sono state estratte queste informazioni.

Non riesco, troppo complesso.
Qualcuno può metterci le mani?
Grazie


La cartella "radice", contenente le sottocartelle dalle quali
estrapolare i dati, è in:
C:\ArchivioSchedeProdotti
All'interno di questa cartella ci sono tutte le sottocartelle da
scansionare.

Il foglio excel che contiene le colonne nelle quali raccogliere i dati è in:
C:\DatiProdotti

Il foglio Excel si chiama:
DatiProdotti.xlsm

Il Tab che contiene le colonne dei dati estrapolati si chiama:
EstrapolaListeSchede

Le colonne sono:
D; E; F; G

La prima riga da impegnare con i risultati è la 6




--
Questa email è stata esaminata alla ricerca di virus da AVG.
http://www.avg.com

[casanmaner]

Ciao Alessandro,
è un periodo un po' difficile per vari motivi e quindi con tempo ridotto, ma ti propongo una funzione che restituisce la matrice dei valori da te richiesti.

Questa matrice di valori poi la puoi assegnare a un intervallo, cosa che ti dovrebbe essere non impossibile viste le tue conoscenze.
La funzione è questa:


Function EstrapolaListeSchede() As Variant
Const sPercorsoRadice = "C:\ArchivioSchedeProdotti\"
Dim oFso As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Dim sFileNameNoExt As String
Dim sPrefisso As String
Dim sTesto As String
Dim sSuffisso As String
Dim sLink As String
Dim arrDati() As Variant
Dim cont As Long
Set oFso = CreateObject("Scripting.FileSystemObject")
With oFso
Set oFolder = oFso.GetFolder(sPercorsoRadice)
For Each oSubFolder In oFolder.SubFolders
For Each oFile In oSubFolder.Files
cont = cont + 1
sFileNameNoExt = .GetBaseName(oFile)
sPrefisso = Trim(Left(sFileNameNoExt, InStr(1, sFileNameNoExt, " ")))
sTesto = Trim(Mid(sFileNameNoExt, InStr(1, sFileNameNoExt, " "), 1 + Len(sFileNameNoExt) - InStr(1, sFileNameNoExt, " ") - InStr(1, sFileNameNoExt, " ")))
sSuffisso = Trim(Right(sFileNameNoExt, Len(sFileNameNoExt) - InStrRev(sFileNameNoExt, " ")))
sLink = Replace(oFile, oFile.Name, "")
ReDim Preserve arrDati(1 To 4, 1 To cont)
arrDati(1, cont) = sPrefisso
arrDati(2, cont) = sTesto
arrDati(3, cont) = sSuffisso
arrDati(4, cont) = sLink
Next oFile
Next oSubFolder
End With
EstrapolaListeSchede = Application.Transpose(arrDati)
End Function


di seguito un banale esempio di assegnazione dei valori a un intervallo

Sub RiportaDati()
Dim arr As Variant
arr = EstrapolaListeSchede
Range("D6").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

Vedi se ti può essere utile.
Ti metto anche il link a dropbox di un file con il codice in modo da poterlo copiare direttamente dai moduli.

ciao

[casanmaner]

Mi sono dimenticato di incollare il link.
Eccolo:

https://www.dropbox.com/s/bv2iwi639fc8iev/Estrapolazione%20dati%20dai%20nomi%20dei%20files%20di%20alcune%20cartelle.xlsm?dl=0

[Final Job]

Ciao, figurati. Grazie per il tempo dedicato.
Ale

[Final Job]

Ciao Casanmaner
C'è un malfunzionamento che blocca la procedura. Penso che l'origine del
problema sia quando incontra nomi files che presentano più spazi, può
essere? Se così fosse, bisogna assumere che:

il prefisso sia tutto ciò che arriva fino al primo spazio escluso
(esclusi anche eventuali spazi iniziali che dovessero erroneamente
essere presenti).

Il suffisso sia tutto ciò che va dall'ultimo spazio escluso fino a fine
stringa (esclusi anche eventuali spazi finali che dovessero erroneamente
essere presenti).

Tutto ciò che è in mezzo è il testo da riportare nella colonna "E"
(spazi interni alla stringa compresi).

La parte di procedura che va in conflitto penso sia:

sTesto = Trim(Mid(sFileNameNoExt, InStr(1, sFileNameNoExt, " "), 1 +
Len(sFileNameNoExt) - InStr(1, sFileNameNoExt, " ") - InStr(1,
sFileNameNoExt, " ")))

Però non voglio che tu perda tempo se hai altro cui pensare. Basta che
mi confermi le supposizioni.

Grazie
Ale

[Final Job]

Scusate, correggo la considerazione; il problema potrebbe essere
l'errore che si genera quando la procedura trova un nome file che è
formato da una sola parola senza spazi.

Confermo che si blocca all'istruzione:

sTesto = Trim(Mid(sFileNameNoExt, InStr(1, sFileNameNoExt, " "), 1 +
Len(sFileNameNoExt) - InStr(1, sFileNameNoExt, " ") - InStr(1,
sFileNameNoExt, " ")))

Dove indico alla procedura che la stampa della tabella va inserita nel
TAB "EstrapolaListeSchede"?

Ciao, grazie nuovamente.
Ale

[Final Job]

Confermo e noto anche un'imprecisione nella considerazione della
lunghezza della stringa di volta in volta in esame.

Il nome file:
Prova011 CNX QUESTO TESTO
lo splitta in questo modo:
colonna D = Prova011
colonna E = CNX QUE (si perde i caratteri "STO")
colonna F = TESTO

Il nome file:
ABC5225 CNX QUESTO TESTO
lo splitta in questo modo:
colonna D = ABC5225
colonna E = CNX QUES (si perde i caratteri "TO")
colonna F = TESTO

[casanmaner]

Ciao Ale,
prova a scaricare di nuovo il file dallo stesso link iniziale.
Ho modificato la funzione che ora dovrebbe gestire correttamente il caso di spazi iniziali, più spazi tra suffisso, testo e prefisso, e il caso di solo testo senza spazi.

Per riportare i dati nel foglio devi copiare la funzione in un modulo della cartella di lavoro e creare una "sub" dove vai a indicare in che foglio e in che range riportare i valori che vengono restituiti dalla funzione.

Sub RiportaDati()
Dim arr As Variant
arr = EstrapolaListeSchede
Range("D6").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

Function EstrapolaListeSchede() As Variant
Const sPercorsoRadice = "C:\ArchivioSchedeProdotti\"
Dim oFso As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Dim sFileNameNoExt As String
Dim sPrefisso As String
Dim sTesto As String
Dim sSuffisso As String
Dim sLink As String
Dim arrDati() As Variant
Dim cont As Long

Dim iLen As Long, iStart As Long, iEnd As Long, iMid As Long

Set oFso = CreateObject("Scripting.FileSystemObject")
With oFso
Set oFolder = oFso.GetFolder(sPercorsoRadice)
For Each oSubFolder In oFolder.SubFolders
For Each oFile In oSubFolder.Files
cont = cont + 1

sFileNameNoExt = Application.Trim(.GetBaseName(oFile))

iLen = Len(sFileNameNoExt)
iStart = InStr(1, sFileNameNoExt, " ") - 1
iEnd = Len(sFileNameNoExt) - InStrRev(sFileNameNoExt, " ", -1)
If iEnd = iLen Then iEnd = 0
iMid = Len(sFileNameNoExt) - (iEnd + iStart) - 1

If iStart > 0 Then
sPrefisso = (Left(sFileNameNoExt, iStart))
Else
sPrefisso = vbNullString
End If
If iMid = 0 Then
sTesto = sFileNameNoExt
Else
sTesto = (Mid(sFileNameNoExt, iStart + 2, iMid))
End If
If iEnd > 0 Then
sSuffisso = (Right(sFileNameNoExt, iEnd))
Else
sSuffisso = vbNullString
End If

[Final Job]

Ti faccio lavorare di buon mattino,caro "EM". Grazie e mi spiace.

Funziona, con due particolarità:

1) nel caso in cui il titolo del file abbia una sola parola, inserisce
il risultato nella seconda colonna ( La E. Dovrebbe andare nella prima,
la A, lasciando le altre due vuote).

2) Il testo che viene riportato nella colonna E, quello di mezzo per
intendersi, si porta dietro lo spazio che lo separa nell'ultima parte
del nome file. Sarebbe utile che non fosse compreso quindi ho aumentato
a -2 la seguente istruzione:
iMid = Len(sFileNameNoExt) - (iEnd + iStart) - 2
Non mi pare possa avere effetti indesiderati nel complesso della procedura.

Ultima cosa. Al fine di mostrare i risultati dell'elaborazione in un
preciso foglio, mi suggerisci quanto segue:

"copiare la funzione in un modulo della cartella di lavoro e creare una
"sub" dove vai a indicare in che foglio e in che range riportare i
valori che vengono restituiti dalla funzione"

Ma se io indico il foglio all'inizio di questa istruzione, c'è qualche
considerazione che manco di fare?
ES:
Sheets("EstrapolaListeSchede").Range("D6").Resize(UBound(arr, 1),
UBound(arr, 2)).Value = arr

Funziona.

Buona giornata e grazie nuovamente per il tempo.
Ale

[casanmaner]

Il giorno giovedì 28 luglio 2022 alle 22:44:34 UTC+2 Final Job ha scritto:
> Ti faccio lavorare di buon mattino,caro "EM". Grazie e mi spiace.
>
> Funziona, con due particolarità:
>
> 1) nel caso in cui il titolo del file abbia una sola parola, inserisce
> il risultato nella seconda colonna ( La E. Dovrebbe andare nella prima,
> la A, lasciando le altre due vuote).

Avevo inteso che in caso di file con una sola parola questo fosse il testo e non un suffisso.

Ho modificato lo stesso file, scaricabile allo stesso link, per fare in modo che in questa ipotesi il nome del file venga inserito come suffisso e non come testo.

>
> 2) Il testo che viene riportato nella colonna E, quello di mezzo per
> intendersi, si porta dietro lo spazio che lo separa nell'ultima parte
> del nome file. Sarebbe utile che non fosse compreso quindi ho aumentato
> a -2 la seguente istruzione:
> iMid = Len(sFileNameNoExt) - (iEnd + iStart) - 2
> Non mi pare possa avere effetti indesiderati nel complesso della procedura.

Nel caso di nomi di file che contengono una sola parola viene tagliata l'ultima lettera.
Conviene lasciare -1 e usare il "Trim" sull'istruzione:
sTesto = Trim(Mid(sFileNameNoExt, iStart + 2, iMid))

>
> Ultima cosa. Al fine di mostrare i risultati dell'elaborazione in un
> preciso foglio, mi suggerisci quanto segue:
> "copiare la funzione in un modulo della cartella di lavoro e creare una
> "sub" dove vai a indicare in che foglio e in che range riportare i
> valori che vengono restituiti dalla funzione"
> Ma se io indico il foglio all'inizio di questa istruzione, c'è qualche
> considerazione che manco di fare?
> ES:
> Sheets("EstrapolaListeSchede").Range("D6").Resize(UBound(arr, 1),
> UBound(arr, 2)).Value = arr
>
> Funziona.
>

Hai fatto quello che intendevo :-)
Dalla cartella di lavoro in cui è presente il foglio "EstrapolaListeSchede" ha indicato qual è il foglio e qual è il range.
Però se ad es. il numero di file si modificasse perché ne venissero cancellati dovresti eliminare i dati presenti in quell'intervallo e poi nuovamente assegnare all'intervallo, che viene definito in modo dinamico, i valori di "arr".

[Final Job]

Grazie, tutto chiaro.
Spero di non esserti stato troppo d'intralcio per le tue cose.
Ale

[issdr]

Final Job wrote:

> Ho una Cartella con, al suo interno, più sottocartelle contenenti
> files che sono nominaticon:
> - un prefisso alfanumerico
> - un testo in mezzo
> - un suffisso finale.

[...]

(una variante rispetto all'ottimo casanmaner)

--8<---------------cut here---------------start------------->8---
Sub Estrapola_nomi_file()

Const sPercorsoRadice = "C:\ArchivioSchedeProdotti"

Set oFso = CreateObject("Scripting.FileSystemObject")
With oFso
Set oFolder = oFso.GetFolder(sPercorsoRadice)

i = 6

For Each oSubFolder In oFolder.SubFolders

For Each oFile In oFolder.Files
sFileNameNoExt = Trim$(.GetBaseName(oFile))
sPrefisso = "": sTesto = "": sSuffisso = ""
aSegmenti = Split(sFileNameNoExt)
Select Case UBound(aSegmenti)
Case Is < 1
sTesto = sFileNameNoExt
Case 1
sTesto = aSegmenti(0)
sSuffisso = aSegmenti(1)
Case Is > 1
sPrefisso = aSegmenti(0)
For n = 1 To UBound(aSegmenti) - 1
sTesto = Trim$(sTesto & " " & aSegmenti(n))
Next
sSuffisso = aSegmenti(UBound(aSegmenti))
End Select
Cells(i, "D") = sPrefisso
Cells(i, "E") = sTesto
Cells(i, "F") = sSuffisso
Cells(i, "G") = oFile.ParentFolder
i = i + 1

Next oFile
Next oSubFolder
End With

End Sub
--8<---------------cut here---------------end--------------->8---

[issdr]

issdr wrote:

> For Each oFile In oFolder.Files

[issdr]

issdr wrote:

> Sub Estrapola_nomi_file()

[...]

*** 8,11 ****
--- 8,15 ----

For Each oFile In oSubFolder.Files

sFileNameNoExt = Trim$(.GetBaseName(oFile))
+ Do
+ TempString = sFileNameNoExt
+ sFileNameNoExt = Replace(sFileNameNoExt, " ", " ")
+ Loop Until TempString = sFileNameNoExt

[Final Job]

Grazie anche a te
Ale

[Final Job]

Anche con questo codice, però, nel caso in cui il nome file sia formato
da una sola parola, questa viene posta nella colonna "E" invece che
nella "D"

[issdr]

Final Job wrote:

> Anche con questo codice, però, nel caso in cui il nome file sia
> formato da una sola parola, questa viene posta nella colonna "E"
> invece che nella "D"

mi era sfuggita questa richiesta. semplice ritoccarlo, vedi Case Is < 2.

se le parole sono solo due ti va bene stiano in "E" ed "F"? in caso
negativo, applica la stessa logica in Case 2: sTesto diventa sPrefisso,
sSuffisso diventa sTesto.

avendolo ripreso per mano ho cambiato anche qualche altra cosa.

--8<---------------cut here---------------start------------->8---
Sub Estrapola_nomi_file()

Set oFso = CreateObject("Scripting.FileSystemObject")

Set oFolder = oFso.GetFolder("C:\ArchivioSchedeProdotti")

i = 6
For Each oSubFolder In oFolder.SubFolders

For Each oFile In oSubFolder.Files

sFileNameNoExt = Trim$(oFso.GetBaseName(oFile))
Do
TempString = sFileNameNoExt

sFileNameNoExt = Replace(sFileNameNoExt, " ", " ")

Loop Until TempString = sFileNameNoExt
sPrefisso = "": sTesto = "": sSuffisso = ""

aSegmenti = Split(sFileNameNoExt) 'fraziona la stringa ripulita
Select Case UBound(aSegmenti) + 1 'numero di "parole"
Case Is < 2
sPrefisso = sFileNameNoExt
Case 2

sTesto = aSegmenti(0)
sSuffisso = aSegmenti(1)

Case Is > 2

sPrefisso = aSegmenti(0)
For n = 1 To UBound(aSegmenti) - 1

sTesto = IIf(n - 1, sTesto & " ", "") & aSegmenti(n)

Next
sSuffisso = aSegmenti(UBound(aSegmenti))
End Select
Cells(i, "D") = sPrefisso
Cells(i, "E") = sTesto
Cells(i, "F") = sSuffisso
Cells(i, "G") = oFile.ParentFolder
i = i + 1
Next oFile
Next oSubFolder

[Final Job]

Funziona, grazie anche per le spiegazioni.
Perchè hai cambiato struttura al codice?
Ale

[issdr]

Final Job wrote:

> Perchè hai cambiato struttura al codice?

leggibilità e un po' più d'efficienza