Selezionare Folder e richiamarne il percorso

Hai un problema con Excel?

Nuova discussione

Selezionare Folder e richiamarne il percorso
di Enrico (utente non iscritto) data: 26/01/2014 11:48:37
Ciao ragazzi, sono Enrico.

Ho provato a fare un giro nel web ma non riesco a venirne a capo.
Spiego brevemente la macro e cosa mi servirebbe. La macro deve prendere tutti i file in una cartella (ognuno dei quali ha 4 fogli di struttura identica ma con info diverse) e li incolla nel file dove la macro gira su 4 fogli appositi. Poi sulla base di due fogli di analisi vi è una dashboard che si aggiorna.

Quello che non riesco ad impostare è il Dialog folder. Praticamente io al momento in ognuno dei 4 moduli faccio puntare alla macro una cartella da uno specifico percorso (ad esempio C:Documents and Settings.......). Io invece vorrei che l'utente la selezionasse una sola volta e che questo percorso fosse richiamato nei 4 moduli

La parte che dovrei modificare è questa

MioPercorso = "C:Documents and Settings ome.cognomeDesktopRaccolta dati"
MioFile = Dir(MioPercorso & "*.xls")

Come faccio a fare in modo che MioPercorso diventi il percorso della cartella selezionata dall'utente?

Vi ringrazio anticipatamente per la vostra disponibilità e spero di essere stato chiaro sul problema.

Grazie e buona domenica

di patel data: 26/01/2014 14:01:41
un esempio

Sub Opendialog9()
Dim strFile As String, strPath As String

    ' Prompt user to select a file
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = "E:prova*.xls*" 'ThisWorkbook.Path & "e*.xls*"
        .Title = "Please Select a File"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub            ' User clicked cancel: Exit
        strFile = .SelectedItems(1)
    End With
    msgbox strFile
End Sub

di Enrico (utente non iscritto) data: 26/01/2014 15:07:11
Ciao Patel,
se non sbaglio (non sono un fenomeno di macro e vba) il codice che hai messo mi fa selezionare un determinato file. Io invece vorrei che venissero aperti tutti i file in una data cartella.
Da lì parte il mio pezzo di macro dove "mio percorso" indica la cartella e poi "mio file" gli dice di aprire tutti i file excel dentro quella cartella.
Mi sembra che il tuo codice non mi aiuti o sbaglio?
Forse non mi ero spiegato bene, non so fammi sapere.

Grazie!

di patel data: 26/01/2014 16:30:38
ti eri spiegato bene, sono io che ho letto quello che volevo io, intendi questo ?

Sub SelectFolder() '  dialog
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    InitialFoldr$ = "E:prova" '<<< Startup folder
    With Application.FileDialog(msoFileDialogFolderPicker) 'User input for folder to look at
        .InitialFileName = Application.DefaultFilePath & ""
        .Title = "Please select a folder to list Files from"
        .InitialFileName = InitialFoldr$
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        mfolder = .SelectedItems(1) & ""
    End With
    MsgBox mfolder & "  selected"
End Sub

di patel data: 26/01/2014 17:41:04
oppure questo

Sub OpenDialogfileUpdate()
Dim strFile As String
Set sh = ActiveSheet
r = 2 ' initial row
Set objFSO = CreateObject("Scripting.FileSystemObject")
InitialFoldr$ = "E:prova" '<<< Startup folder
With Application.FileDialog(msoFileDialogFolderPicker) 'User input for folder to look at
  .InitialFileName = Application.DefaultFilePath & ""
  .Title = "Please select a folder to list Files from"
  .InitialFileName = InitialFoldr$
  .Show
  If .SelectedItems.Count = 0 Then Exit Sub
  mfolder = .SelectedItems(1) & ""
End With
strFile = Dir(mfolder & "*.xls*")
Do While strFile <> ""
    Workbooks.Open mfolder & strFile
' ---------- tuo codice
    ActiveWorkbook.Close True
    r = r + 1
    strFile = Dir
Loop

di Grograman data: 27/01/2014 08:34:30
Estremamente da adattare allo scopo:

Private Sub Sfoglia_Files()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' ATTENZIONE RICHIEDE L'ATTIVAZIONE DELLA LIBRERIA MICROSOFT SCRIPTING RUNTIME '''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Per l'attivazione andare su "Strumenti", "Riferimenti", cercare e spuntare il nome ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
    Dim strPath As String
    Dim fd As FileDialog
    Dim objfd As Variant
    
    Dim objFSY As FileSystemObject
    Dim objFOL As Folder
    Dim objFIL As File
    
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
			.InitialFileName = "C:"
			.Title = "Sfoglia cartelle"
			.ButtonName = "Ok"
			.AllowMultiSelect = False
			.InitialView = msoFileDialogViewDetails
			.Show
			For Each objfd In .SelectedItems
				strPath = objfd
			Next objfd
    End With
    
    If strPath = "" Then GoTo Uscita
    
    Set objFSY = New FileSystemObject
    Set objFOL = objFSY.GetFolder(strPath)
    
    For Each objFIL In objFOL.Files
            Debug.Print objFIL.Name 'o altre azioni da fare sui files
    Next
Uscita:
    Set objFSY = Nothing
    Set objFOL = Nothing
    Set fd = Nothing
End Sub

di Enrico (utente non iscritto) data: 28/01/2014 23:51:08
Ciao ragazzi,
scusate il ritardo nella risposta ma il lavoro mi ha preso un pò troppo in questi giorni.

Allora sinceramente non capisco bene quale possa essere quella che meglio si adatta alla mia macro nè dove dovrei inserirla (anche se ho fatto un pò di tentativi).
Inserisco il codice della mia macro e spero che qualcuno possa aiutarmi sul "dove inserire una di quelle macro da voi proposte" (userei la più semplice che mi sembra la prima di patel)

Spero davvero in un vostro aiuto e vi ringrazio in anticipo!!

Buona notte!!

Sub Leggi_Dati_e_Copia_Celle_di_SALES()
    Application.ScreenUpdating = False
    Nome_Precedente = ActiveWorkbook.Name
    MioPercorso = "C:Documents and Settingsenrico.ferreriDesktopProva BI Navigator"
    MioFile = Dir(MioPercorso & "*.xls")
    RR = Range("B" & Rows.Count).End(xlUp).Row
    Workbooks(Nome_Precedente).Worksheets("SALES").Visible = xlSheetVisible
    If RR = 1 Then
        RR = 2
    End If
            Cancella_tutto_di_SALES
        Windows(Nome_Precedente).Activate
    Sheets("SALES").Select
    Range("A2:AR" & RR).ClearContents
        RR = 1
    Do While MioFile <> ""
        I = RR + 1
        Cells(I, 1) = MioFile
                Scrivi_Dati_di_SALES
                        MioFile = Dir()
    Loop
    Workbooks(Nome_Precedente).Worksheets("SALES").Visible = xlSheetHidden
    Application.ScreenUpdating = True
    End Sub

Sub Scrivi_Dati_di_SALES()
    Workbooks.Open Filename:=MioPercorso & Cells(I, 1)
    Sheets("SALES").Select
    RR = Range("D" & Rows.Count).End(xlUp).Row
    Range("B11:AO" & RR).Copy
    Windows(Nome_Precedente).Activate
    Sheets("SALES").Select
    Range("B" & I).PasteSpecial Paste:=xlPasteValues
    RR = Range("B" & Rows.Count).End(xlUp).Row
    Range("A" & I).Copy
    Range("A" & I + 1 & ":A" & RR).Select
    ActiveSheet.Paste
    Windows(MioFile).Close savechanges:=False

End Sub
Sub Cancella_tutto_di_SALES()
'
' Cancella_tutto Macro
'

'
     Sheets("SALES").Select
    Range("A2:AR1048575").ClearContents
    
End Sub

di patel data: 29/01/2014 08:10:58
l'ha già detto tu nel primo post dove inserire il codice, al posto di mio percorso ....
di Enrico (utente non iscritto) data: 30/01/2014 11:31:27
Ciao Patel,
io ti ringrazio tanto ma sono talmente negato, nonostante i miei sforzi che non riesco proprio a capire.

Io sulla base della mia macro postata qualche post indietro ho provato a mettere la tua macro al posto del percorso inserito sotto "mio percorso" ma non funziona, ho provato ad inserire il tuo pezzo sotto denominandolo come "mio percorso" ma la parte che dice mio file = ..... non lo recepisce...
Sinceramente non so dove sbattere la testa....
Se non ti disturba troppo te ne sarei grato se mi facessi un esempio specifico di dove dovrei inserirlo, altrimenti vorrà dire che nel weekend ci perderò un pò di tempo sopra.

Ad ogni modo grazie mille per gli spunti,

buona giornata,

Enrico
di patel data: 30/01/2014 12:17:07
mi sembra più sensato che TU alleghi il file con la macro che hai modificato
di Zer0Kelvin data: 02/02/2014 04:34:20
Ciao.
Non ho letto tutto il post ma, in base al quesito di partenza, dopo aver selezionato la cartella MioPercorso, dovrebbe essere sufficiente:
ChDdrive(MioPercorso) ChDir(MioPercorso)

di Zer0Kelvin data: 02/02/2014 14:39:37
Rileggendo meglio, mi sono accorto di un errore GRAVISSIMO da te commesso: tu usi variabili con lo stesso nome in sub differenti pensando che siano la stessa variabile, MA NON E' COSI'.
Prima di avventurarsi nella programmazione, bisognerebbe capire come funzionano le variabili.
Innanzitutto, anche se in VBA non è obbligatorio (che Microsoft bruci all'inferno per questo) LE VARIABILI VANNO DICHIARATE.
In pratica succede questo, Es.:

Sub Leggi_Dati_e_Copia_Celle_di_SALES()
........
MioPercorso = "C:Documents and Settingsenrico.ferreriDesktopProva BI Navigator"

VBA incontra una parola sconosciuta (MioPercorso ), quindi presume che si tratti di una variabile LOCALE (cioè valida solo all'interno della routine corrente), crea una variabile di tipo Variant e le assegna il valore richiesto .

Sub Scrivi_Dati_di_SALES()
Workbooks.Open Filename:=MioPercorso & Cells(I, 1)

Come prima VBA incontra un nome sconosciuto, in quanto la variabile precedente (LOCALE) non è visibile al di fuori della Routine Leggi_Dati_e_Copia_Celle_di_SALES e smette di esistere quando la routine termina; quindi crea una NUOVA variabile di tipo Variant ed ovviamente non le assegna alcun valore. La seconda variabile NON CONTIENE NULLA!
Ecco come dovrebbe essere il codice ( Option Explicit all'inizio del modulo serve a rendere obbligatoria la dichiarazione delle variabili)

Option Explicit

Dim MioPercorso As String, Nome_Precedente As String, MioFile As String 'queste variabili sono visibili in tutto il modulo
Dim I As Long 'idem

Sub Leggi_Dati_e_Copia_Celle_di_SALES()
Dim RR As Long 'questa variabile è visibile solo all'interno di questa routine
    Application.ScreenUpdating = False
    Nome_Precedente = ActiveWorkbook.Name
    MioPercorso = "C:Documents and Settingsenrico.ferreriDesktopProva BI Navigator"
    MioFile = Dir(MioPercorso & "*.xls")
    RR = Range("B" & Rows.Count).End(xlUp).Row
    Workbooks(Nome_Precedente).Worksheets("SALES").Visible = xlSheetVisible
    If RR = 1 Then
        RR = 2
    End If
            Cancella_tutto_di_SALES
        Windows(Nome_Precedente).Activate
    Sheets("SALES").Select
    Range("A2:AR" & RR).ClearContents
        RR = 1
    Do While MioFile <> ""
        I = RR + 1
        Cells(I, 1) = MioFile
                Scrivi_Dati_di_SALES
                        MioFile = Dir()
    Loop
    Workbooks(Nome_Precedente).Worksheets("SALES").Visible = xlSheetHidden
    Application.ScreenUpdating = True
End Sub

Sub Scrivi_Dati_di_SALES()
Dim RR As Long 'idem
    Workbooks.Open Filename:=MioPercorso & Cells(I, 1)
    Sheets("SALES").Select
    RR = Range("D" & Rows.Count).End(xlUp).Row
    Range("B11:AO" & RR).Copy
    Windows(Nome_Precedente).Activate
    Sheets("SALES").Select
    Range("B" & I).PasteSpecial Paste:=xlPasteValues
    RR = Range("B" & Rows.Count).End(xlUp).Row
    Range("A" & I).Copy
    Range("A" & I + 1 & ":A" & RR).Select
    ActiveSheet.Paste
    Windows(MioFile).Close savechanges:=False

End Sub

Sub Cancella_tutto_di_SALES()
    Sheets("SALES").Select
    Range("A2:AR1048575").ClearContents
End Sub

di Zer0Kelvin data: 02/02/2014 14:41:47
PS: invece di usare variabili globali sarebbe opportuno ricorrere al passaggio di parametri.
di Enrico (utente non iscritto) data: 02/02/2014 14:54:25
Ciao zerokelvin,
Le variabili io le ho dichiarate chiaramente. Non ho riportato nella macro che ho messo sul forum la parte di option explicit ma chiaramente le ho dichiarate. Purtroppo rimango bloccato nel senso non capisco se la macro di patel ad esempio dovrebbe essere usata come ulteriore sub oppure no? O cmq la posizione di quella funzione di selezione cartella all'interno della macro. Purtroppo non ho ancora avuto tempo di caricare la macro all'interno del forum ma credo anche che non ve ne sia bisogno se solo riuscissi a capire dove inserire il "seleziona cartella"...forse più tardi avrò del tempo per smanettarci un pò, ma chiaramente se sapessi indicarmi il "dove" applicarmi mi sarebbe di grande aiuto.

Grazie,
Enrico

di Zer0Kelvin data: 02/02/2014 18:52:55
Premesso che stò andando un pò a naso, non avendo sottomano i files e relative strutture, tutto ciò di cui dovresti aver bisogno è qualcosa del genere:

Option Explicit

Sub Leggi_Dati_e_Copia_Celle_di_SALES()
Dim RR As Long, I As Long
Dim MioPercorso As String, MioFile As String
    MioPercorso = "C:Documents and Settingsenrico.ferreriDesktopProva BI Navigator"
    'oppure
    'MioPercorso = GetFolderName & ""
    MioFile = Dir(MioPercorso & "*.xls")
    ActiveWorkbook.Sheets("SALES").UsedRange.ClearContents
    RR = 1
    Do While MioFile <> ""
        I = RR + 1
        Cells(I, 1) = MioFile
        Scrivi_Dati_di_SALES MioFile, I
        MioFile = Dir()
    Loop
End Sub

Sub Scrivi_Dati_di_SALES(fName As String, Index As Long)
Dim WkNew As Workbook, SH2 As Worksheet, SH1 As Worksheet
Dim RR As Long
    Application.ScreenUpdating = False
    Set SH1 = ActiveWorkbook.Sheets("SALES")
    Set WkNew = Workbooks.Open(fName)
    Set SH2 = WkNew.Sheets("SALES")
    RR = SH2.Range("D" & Rows.Count).End(xlUp).Row
    SH2.Range("B11:AO" & RR).Copy
    SH1.Range("B" & Index).PasteSpecial Paste:=xlPasteValues
    RR = SH1.Range("B" & Rows.Count).End(xlUp).Row
    SH1.Range("A" & Index).Copy Destination:=SH1.Range("A" & Index + 1 & ":A" & RR)
    WkNew.Close savechanges:=False
    Application.ScreenUpdating = True
End Sub

Function GetFolderName() As String
    GetFolderName = ""
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then GetFolderName = .SelectedItems(1)
    End With
End Function

di Zer0Kelvin data: 02/02/2014 18:54:07
PS: ovviamente NON E' TESTATO e potrei aver male interpretato il tuo codice...

di Zer0Kelvin data: 02/02/2014 18:59:07
Piccola svista:

        Scrivi_Dati_di_SALES MioFile, I
deve essere invece
        Scrivi_Dati_di_SALES MioPercorso & MioFile, I

di scossa data: 02/02/2014 19:57:20
cit Enrico: "Le variabili io le ho dichiarate chiaramente. Non ho riportato nella macro che ho messo sul forum la parte di option explicit ma chiaramente le ho dichiarate. .....
........ Purtroppo non ho ancora avuto tempo di caricare la macro all'interno del forum ma credo anche che non ve ne sia bisogno .... "

Scommetto che se tu potessi, avendo mal di schiena, al medico porteresti solo la schiena ...

di Enrico (utente non iscritto) data: 03/02/2014 12:12:38
Buongiorno a tutti,
scusate se poi ieri non sono riuscito a dare alcun riscontro.
Finalmente il problema è risolto grazie al vostro aiuto e alla vostra pazienza. Alla fine ho utilizzato il codice di Zer0Kelvin ed il mio codice adesso risulta questo.

@Zer0Kelvin perchè mi dici quella piccola svista:

Scrivi_Dati_di_SALES MioFile, I
deve essere invece
Scrivi_Dati_di_SALES MioPercorso & MioFile, I

A me anche senza questa modifica gira perfettamente (in realtà mi sembra normale che giri anche perchè MioFile include già l'informazione MioPercorso essendo MioFile= Dir(MioPercorso & "*.xls").
Se mi sfugge qualcosa ti prego di farmelo presente.

Ringrazio tutti e dichiaro il mio problema risolto!!
Ancora grazie e buon giornata

Enrico

Option Explicit
Public MioPercorso As String, MioFile As String, I As Integer, J As Integer, RR As Integer, Nome_Precedente As String  ''Per gli amanti delle battute (ogni riferimento a sossa è puramente voluto) non avevo inserito questa parte semplicemente perchè di corsa ma anche perchè ritenessi fosse veramente scontato, ma forse mi sbagliavo e questo non capiterà più. Prossima volta posto con le dichiarazioni di variabili fin da subito 

Sub Leggi_Dati_e_Copia_Celle_di_SALES()
    Application.ScreenUpdating = False
    Nome_Precedente = ActiveWorkbook.Name
    MioPercorso = GetFolderName & ""
    '"C:Documents and Settingsenrico.ferreriDesktopRaccolta dati LBP"
    MioFile = Dir(MioPercorso & "*.xls")
    RR = Range("B" & Rows.Count).End(xlUp).Row
    Workbooks(Nome_Precedente).Worksheets("SALES").Visible = xlSheetVisible
    If RR = 1 Then
        RR = 2
    End If
    
        Cancella_tutto_di_SALES
    
    Windows(Nome_Precedente).Activate
    Sheets("SALES").Select
    Range("A2:AR" & RR).ClearContents
    
    RR = 1
    Do While MioFile <> ""
        I = RR + 1
        Cells(I, 1) = MioFile
        
        Scrivi_Dati_di_SALES
                
        MioFile = Dir()
    Loop
    Workbooks(Nome_Precedente).Worksheets("SALES").Visible = xlSheetHidden
    Application.ScreenUpdating = True
    
End Sub


Sub Scrivi_Dati_di_SALES()
    Workbooks.Open Filename:=MioPercorso & Cells(I, 1)
    Sheets("SALES").Select
    RR = Range("D" & Rows.Count).End(xlUp).Row
    Range("B11:AO" & RR).Copy
    Windows(Nome_Precedente).Activate
    Sheets("SALES").Select
    Range("B" & I).PasteSpecial Paste:=xlPasteValues
    RR = Range("B" & Rows.Count).End(xlUp).Row
    Range("A" & I).Copy
    Range("A" & I + 1 & ":A" & RR).Select
    ActiveSheet.Paste
    Windows(MioFile).Close savechanges:=False

End Sub
Sub Cancella_tutto_di_SALES()
'
' Cancella_tutto Macro
'

'
     Sheets("SALES").Select
    Range("A2:AR1048575").ClearContents
    
End Sub


Function GetFolderName() As String
    GetFolderName = ""
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then GetFolderName = .SelectedItems(1)
    End With
End Function

di Enrico (utente non iscritto) data: 03/02/2014 14:53:26
Scusate ma non riuscivo ad editare il post precedente. Scrivo questo messaggio solo per spuntare il tastino con "discussione risolta" che nel post precedente non me l'ha preso

Vuoi Approfondire?