Condividi:        

ESTRARRE la DATA dalla PROPRIETA' DEL FILE

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

ESTRARRE la DATA dalla PROPRIETA' DEL FILE

Postdi scanacc » 16/10/20 18:51

In pratica devo inserire nel "FILE A" la data del giorno in cui è stato fatto il download del "FILE B"
Purtroppo nel FILE B non ci sono riferimenti in merito e non so come fare se non prenderli nelle proprietà del documento dalla voce "Creazione contenuto". Dato che dovrò ripetere l'operazione per molte volte, un piccolo aiuto sarebbe gradito.
Grazie
scanacc
Utente Senior
 
Post: 350
Iscritto il: 06/12/15 10:30

Sponsor
 

Re: ESTRARRE la DATA dalla PROPRIETA' DEL FILE

Postdi Anthony47 » 16/10/20 23:42

Si puo' lavorare sulle informazioni prelevabili tramite il FileSystemObject.
Ad esempio, partiamo da quanto pubblicato (codice e informazioni) in questa documentazione Microsoft: https://docs.microsoft.com/en-us/office ... ile-object

Possiamo cosi' arrivare alla seguente "Funzione Utente":
Codice: Seleziona tutto
Function ShowFileInfo(ByVal myFile As String, Optional ByVal myOpt As Long = 1) As Variant
    Dim fs, f, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(myFile)
    If myOpt = 1 Then
        ShowFileInfo = f.DateCreated
    ElseIf myOpt = 2 Then
        ShowFileInfo = f.DateLastAccessed
    ElseIf myOpt = 3 Then
        ShowFileInfo = f.DateLastModified
    End If
End Function

La funzione ShowFileInfo così creata va richiamata passandole come "argomenti" il nome file e il Numero di info che si vuole ottenere; al momento ho previsto:
1=DateCreated
2=DateLastAccessed
3=DateLastModified

Ad esempio potrai usare una formula tipo
Codice: Seleziona tutto
=ShowFileInfo("D:\DDownloads\Dieta.xlsx";1)
Per ottenere la data di creazione di quel file

Ovviamente puoi usare una cella per contenere gli argomenti della formula:
Codice: Seleziona tutto
=ShowFileInfo(A2;B2)
(se NomeFile e' in A2 e tipo di informazione voluta e' in B2)

Altre combinazioni di informazioni, oltre alle 3 ora inserite, si possono prevedere esaminando quali sono le Proprieta' del File Object (il link Microsoft)

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: ESTRARRE la DATA dalla PROPRIETA' DEL FILE

Postdi scanacc » 17/10/20 01:17

Grazie Antony, avevo trovato anche questo che funzionava bene
Codice: Seleziona tutto
Public Sub Test()
    Dim wk As Workbook
    Dim sh As Worksheet
    Dim fso As Object
    Dim strFile As String
   
    strFile = "C:\FOCUS\DETTAGLIO\INFO.xlsx"
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set wk = ThisWorkbook
    Set sh = wk.Sheets("Foglio1")
   
    With sh
        .Range("A2").Value2 = fso.GetFile(strFile).DateLastAccessed
        .Range("B2").Value2 = fso.GetFile(strFile).DateCreated
        .Range("C2").Value2 = fso.GetFile(strFile).DateLastModified
        .Range("D2").Value2 = fso.GetFile(strFile).Type
        .Range("E2").Value2 = fso.GetFile(strFile).Size
        .Range("F2").Value2 = fso.GetFile(strFile).Name
        .Range("G2").Value2 = fso.GetFile(strFile).Path

    End With
   
End Sub


Ma da il problema che me ne fa vedere solo 1. Come posso fare in modo che questa macro continui la ricerca di tutti i FILE nella cartella che vorrei indicargli senza indicargli la path esatta del file?
scanacc
Utente Senior
 
Post: 350
Iscritto il: 06/12/15 10:30

Re: ESTRARRE la DATA dalla PROPRIETA' DEL FILE

Postdi Anthony47 » 17/10/20 14:27

Come posso fare in modo che questa macro continui la ricerca di tutti i FILE nella cartella che vorrei indicargli senza indicargli la path esatta del file?
La interpreto così:
-data la directory, come posso ottenere le informazioni di tutti i file presenti nella directory?

In questo caso devi estrarre i nomi file e lavorare su quelli. Ad esempio:
Codice: Seleziona tutto
Sub GetFileInfo()
Dim sh As Worksheet
Dim fSo As Object
Dim lFile As Object, iPath As String
'
iPath = "D:\DDownloads\Amazon_Imag"                     '<<< La directory in cui cercare
Set sh = ThisWorkbook.Sheets("Foglio6")     '<<< Il foglio in cui scaricare i risultati
'
Set fSo = CreateObject("Scripting.FileSystemObject")
I = 1
For Each lFile In fSo.GetFolder(iPath).Files
    I = I + 1
    sh.Cells(I, 1).Value2 = fSo.GetFile(lFile).DateLastAccessed
    sh.Cells(I, 2).Value2 = fSo.GetFile(lFile).DateCreated
    sh.Cells(I, 3).Value2 = fSo.GetFile(lFile).DateLastModified
    sh.Cells(I, 4).Value2 = fSo.GetFile(lFile).Type
    sh.Cells(I, 5).Value2 = fSo.GetFile(lFile).Size
    sh.Cells(I, 6).Value2 = fSo.GetFile(lFile).Name
    sh.Cells(I, 7).Value2 = fSo.GetFile(lFile).Path
    DoEvents
Next lFile
MsgBox ("Elenco completato, n° files: " & I)
End Sub

Le istruzioni marcate <<< vanno personalizzate

Le informazioni saranno riportate nel foglio dichiarato a partire dalla riga 2; non ho inserito una pulizia iniziale del foglio, ed eventuali dati presenti vengono sovrascritti.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: ESTRARRE la DATA dalla PROPRIETA' DEL FILE

Postdi scanacc » 22/10/20 08:42

Perfetto grazie!
scanacc
Utente Senior
 
Post: 350
Iscritto il: 06/12/15 10:30

Re: ESTRARRE la DATA dalla PROPRIETA' DEL FILE

Postdi scanacc » 30/10/20 15:13

Strano però ... mi indica 1 FILE in più. Mi dice che ha estratto i dati di 19 FILE ma in realtà ne elenca, a partire dalla 2a riga, 18 (che è il numero giusto).
scanacc
Utente Senior
 
Post: 350
Iscritto il: 06/12/15 10:30

Re: ESTRARRE la DATA dalla PROPRIETA' DEL FILE

Postdi Anthony47 » 30/10/20 20:07

Speravo non te ne saresti accorto :D

Devi modificare in
Codice: Seleziona tutto
MsgBox ("Elenco completato, n° files: " & I-1)


Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: ESTRARRE la DATA dalla PROPRIETA' DEL FILE

Postdi scanacc » 31/10/20 18:21

Grazie! E pensare che ho provato più volte a vedere se riuscivo a cambiarlo!!!!
Un saluto
scanacc
Utente Senior
 
Post: 350
Iscritto il: 06/12/15 10:30

Re: ESTRARRE la DATA dalla PROPRIETA' DEL FILE

Postdi wallace&gromit » 15/11/20 19:23

Ciao,
nei ritagli di tempo (che attualmente sono pochi) stavo cercando di aggiungere a questa macro un passaggio in cui si vadano a cercare anche le sottocartelle, qualcosa così, prima della riga in cui si cercano i file:
Codice: Seleziona tutto
For Each mySubFolder In fSo.iPath.SubFolders
    iPath = mySubFolder.Path
... niente! non ci riesco.
Office2016 + 2019 su win11
Avatar utente
wallace&gromit
Utente Senior
 
Post: 2174
Iscritto il: 16/01/12 14:21

Re: ESTRARRE la DATA dalla PROPRIETA' DEL FILE

Postdi Anthony47 » 15/11/20 23:47

Potresti partire dalla Function RecurDir che avevamo usato qui: viewtopic.php?p=632550#p632405

La function i restituira’ un array con l’elenco di tutti i file presenti in un percorso e tutte le sue subdir, filtrandoli con un elenco di extension lungo a piacere.

Ottenuto l’elenco ti bastera’ scorrere l’elenco dei file e leggerne le proprieta’.
In pratica, supponendo che (come nella discussione linkata) l’elenco viene restituito nell’array Farr dovrai usare per il ciclo di estrazione NON For Each lFile In fSo.GetFolder(iPath).Files /Next lFile ma qualcosa come
Codice: Seleziona tutto
For J=1 to ubound(Farr)
    lFile=Farr(J)
    I = I + 1
    sh.Cells(I, 1).Value2 = fSo.GetFile(lFile).DateLastAccessed
    'etc etc

Next J

Mi fermo a questo macro livello, sono sicuro che sara' sufficiente; ma se dovessi arenarti siamo qui…

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: ESTRARRE la DATA dalla PROPRIETA' DEL FILE

Postdi wallace&gromit » 19/11/20 17:29

Ok, dopo avere pestato un po' la testa su un paio di bug ho capito che:
- c'era uno spazio di troppo in " D:\..."
- lFile non andava più dimensionato come object ma string
- se inserisco proprio solo "D:\" la function RecurDir va in loop quando trova il cestino

Quest'ultimo punto non ho ancora saputo risolverlo, a parte inserire già qualche directory in più, però mi piacerebbe potere partire proprio dalla base.

Ecco cosa ho fatto:
Codice: Seleziona tutto
Dim myFso As Object, ccAll As Long    'RIGOROSAMENTE IN TESTA AL MODULO
Function RecurDir(ByVal ccDir As String, myExt As Variant, ByRef cStore As Variant) As String
Dim myItm
'
If myFso Is Nothing Then Set myFso = CreateObject("Scripting.FileSystemObject")
If myFso Is Nothing Then Beep
DoEvents
On Error GoTo Mahh
For Each myItm In myFso.GetFolder(ccDir).Files
ccAll = ccAll + 1
    mysplit = Split(" " & myItm, ".", , vbTextCompare)
    If Not IsError(Application.Match(mysplit(UBound(mysplit)), myExt, 0)) Then
        myind = UBound(cStore)
        ReDim Preserve cStore(1 To myind + 1)
        cStore(myind) = myItm
    End If
Mahh:
Resume Bohh
Bohh:
Next myItm
For Each myItm In myFso.GetFolder(ccDir).SubFolders
    Call RecurDir(myItm, myExt, cStore)
Next myItm
End Function

Sub GetFileInfo()
Dim sh As Worksheet
Dim fSo As Object
Dim lFile, iPath As String
'
Set sh = ThisWorkbook.Sheets("Foglio1")     '<<< Il foglio in cui scaricare i risultati
'
Set fSo = CreateObject("Scripting.FileSystemObject")

Dim FArr() As String
ReDim FArr(1 To 1)
allpics = Array("jpg", "png", "gif")    '<<< Altri formati?       '***
StrDir = "D:\"       '<<< Il Percorso iniziale !!!! attenzione, non funziona con solo D
Call RecurDir(StrDir, allpics, FArr)

I = 1

For J = 1 To UBound(FArr)
    lFile = FArr(J)
    I = I + 1
    sh.Cells(I, 1).Value2 = fSo.GetFile(lFile).DateLastAccessed
    sh.Cells(I, 2).Value2 = fSo.GetFile(lFile).DateCreated
    sh.Cells(I, 3).Value2 = fSo.GetFile(lFile).DateLastModified
    sh.Cells(I, 4).Value2 = fSo.GetFile(lFile).Type
    sh.Cells(I, 5).Value2 = fSo.GetFile(lFile).Size
    sh.Cells(I, 6).Value2 = fSo.GetFile(lFile).Name
    sh.Cells(I, 7).Value2 = fSo.GetFile(lFile).Path
    DoEvents
Next J
MsgBox ("Elenco completato, n° files: " & I)
End Sub

Office2016 + 2019 su win11
Avatar utente
wallace&gromit
Utente Senior
 
Post: 2174
Iscritto il: 16/01/12 14:21

Re: ESTRARRE la DATA dalla PROPRIETA' DEL FILE

Postdi Anthony47 » 20/11/20 00:26

Effettivamente il codice rischia di schiantarsi in diverse occasioni, probabilmente anche complici nuove prestazioni di sicurezza introdotte sui S.O. piu' recenti...

Ho quindi preparato una versione che mi pare piu' robusta:
Codice: Seleziona tutto
Dim myFso As FileSystemObject, ccAll As Long    'RIGOROSAMENTE IN TESTA AL MODULO
Dim noDirs

Function RecurDir(ByVal ccDir As String, myExt As Variant, ByRef cStore As Variant) As String
Dim myItm, Dbg As Boolean
'
If myFso Is Nothing Then Set myFso = CreateObject("Scripting.FileSystemObject")
If myFso Is Nothing Then Beep
DoEvents
'
Dbg = False             '<<< Se True allora abilita Debug.Print
'
If Dbg Then Debug.Print ccDir
If myFso.FolderExists(ccDir) Then
    On Error Resume Next
    For Each myItm In myFso.GetFolder(ccDir).Files
        If Err.Number = 92 Then
            If Dbg Then Debug.Print "# 92", ccDir
            Err.Clear
            GoTo eFor
        ElseIf Err.Number > 0 Then
            If Dbg Then Debug.Print "# " & Err.Number, ccDir
            Err.Clear
            GoTo Bohh
        End If
        On Error GoTo 0
        ccAll = ccAll + 1
        mySplit = Split(" " & myItm, ".", , vbTextCompare)
        If Not IsError(Application.Match(mySplit(UBound(mySplit)), myExt, 0)) Then
            myind = UBound(cStore)
            ReDim Preserve cStore(1 To myind + 1)
            cStore(myind) = myItm
        End If
Bohh:
        On Error GoTo 0
        DoEvents
        If IsEmpty(myItm) Then GoTo eFor
        Next myItm
eFor:
        On Error GoTo 0
End If
On Error Resume Next
For Each myItm In myFso.GetFolder(ccDir).SubFolders
    If Err.Number > 0 Then GoTo eFun
    On Error GoTo 0
    nobb = False
    For I = 0 To UBound(noDirs)
        If InStr(1, myItm & "  ", noDirs(I), vbTextCompare) > 0 Then
            nobb = True
            Exit For
        End If
    Next I
    If nobb = False Then Call RecurDir(myItm, myExt, cStore)
Next myItm
eFun:
Err.Clear
End Function



Sub prova()
Dim strFile As String
    Dim stdPic As StdPicture
    Dim lngWidth As Long
    Dim lngHeight As Long
    Dim strPath As String, mySplit
    Dim intRow As Integer, AllPics, StrDir As String, I As Long
'
Dim FArr() As String
Sheets("Foglio1").Select                                    '<<< Il foglio dei risultati
ReDim FArr(1 To 1)
'
AllPics = Array("jpg", "png", "gif")                        '<<< Altri formati?       '***
StrDir = "C:\"                                              '<<< Il Percorso iniziale
noDirs = Array("\$", "\Program", "\Windows", "\AppData")    '<<< Path da escludere
'
Call RecurDir(StrDir, AllPics, FArr)
Range("A1").Resize(UBound(FArr), 1).Value = FArr            'Finalmente scrive da A1 l'elenco

Stop

GoTo eSub           'Termina la sub, se basta l'elenco dei file

'Da qui in poi estrae prorprieta' delle immagini elencate
Application.ScreenUpdating = False
For I = 1 To UBound(FArr)
    DoEvents
    If Len(FArr(I)) > 0 Then
        intRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
        mySplit = Split(FArr(I), "\", , vbTextCompare)
        If UBound(mySplit) > 0 Then Range("B" & intRow).Value = mySplit(UBound(mySplit))
        Range("A" & intRow).Value = Replace(FArr(I), "\" & mySplit(UBound(mySplit)), "\", , , vbTextCompare)
        Range("E" & intRow).Value = myFso.getfile(FArr(I)).Size
    On Error GoTo piPP
        Set stdPic = LoadPicture(FArr(I)) '
        Range("C" & intRow).Value = Round(stdPic.Width / 26.4583)
        Range("D" & intRow).Value = Round(stdPic.Height / 26.4583)
piPP:
        Resume poPP
poPP:
    End If
Next I
eSub:
On Error Resume Next
Application.ScreenUpdating = True
Set myFso = Nothing
On Error GoTo 0
MsgBox ("Elenco completato...")
End Sub


Le modifiche riguardano soprattutto la prima parte, compresa la Function RecurDir.

Tra l'altro ho introdotto la possibilita' di dichiarare un elenco di percorsi da skippare, vedi noDirs = Array("\$", "\Program", etc etc
Attenzione che di quelle chiavi ne viene controllata la presenza in qualsiasi posizione del percorso che viene scandagliato.

Da lanciare e' la Sub Prova, che (col codice pubblicato) scrivera' sul foglio selezionato l'elenco dei file rilevati; poi si ferma sullo Stop e, riavviandola, esce.
Vedo che a te interessa raccogliere informazioni diverse da quelle che raccoglievo io, ma puoi benissimo sostituire la seconda parte di Sub Prova con quello che ti interessa.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: ESTRARRE la DATA dalla PROPRIETA' DEL FILE

Postdi wallace&gromit » 21/11/20 08:48

La prima parte mi fa un comportamento un po' strano: ripete il nome del primo file trovato per tante volte quanti sono i file, ma non fa niente, a me non interessa quella parte, io voglio i dettagli, quindi faccio scrivere solo la seconda parte.
Lavorando sul vecchio catorcio di casa ogni operazione richiede il suo tempo. Ho visto in particolare che la ricerca delle dimensioni delle foto impiega parecchio, ma anche questo è un dato che mi interessa relativamente, quindi ho tolto anche quello.
Ora va che è una meraviglia!
Il mio progetto prosegue, magari (senz'altro) mi ripresenterò per i prossimi dubbi.
Office2016 + 2019 su win11
Avatar utente
wallace&gromit
Utente Senior
 
Post: 2174
Iscritto il: 16/01/12 14:21


Torna a Applicazioni Office Windows


Topic correlati a "ESTRARRE la DATA dalla PROPRIETA' DEL FILE":


Chi c’è in linea

Visitano il forum: Ricky0185 e 52 ospiti