Navigatore

[Anthony47]

Ok, quindi scrivevi Combobox ma pensavi a Textbox... Due frustate?
Lo stesso pero' non riesco a riprodurre il problema... Se il textbox fosse occupato da piu' righe di quante ne puo' visualizzare dovrebbe allora visualizzare la barra di scorrimento verticale.

Comunque prova modificando all'interno della Sub LinkList (io l'avevo messa in Modulo1) la riga UserForm1.TextBox1.Text = ListLnk in

Codice: Seleziona tutto

UserForm1.TextBox1.Text = ""
UserForm1.TextBox1.Text = ListLnk
UserForm1.TextBox1.SelStart = 0     

Ciao

[wallace&gromit]

Noooo! Le frustate che ho evitato di là le prendo di qua! Il bello è che ci ho anche pensato che forse non era un combobox, ma poi mi sono convinto di sì. Ora non sono al pc ma la soluzione sembra ottima, ti faccio sapere

[wallace&gromit]

YESSS! sembra funzionare a puntino, mi mostra le due righe e non mi blocca NumLock.
Meriti un inchino, segni di frustate permettendo...

[wallace&gromit]

Ciao Anthony, riprendo questo post perché lo devo adattare a windows 10.
In pratica, senza riprendere tutte le macro contenute, c'è un passaggio in cui si creava nei preferiti il collegamento diretto alla cartella attiva desiderata.
Ora riesco ad aggiungere all'accesso rapido la cartella "collegamenti", cliccando su quella vedo di volta in volta la cartella attiva.
Una volta selezionata la cartella apparirà sotto l'accesso rapido, ma preferirei evitare questo passaggio.
È possibile aggiungere direttamente la cartella attiva sotto accesso rapido?
Qui la parte di macro che funzionava in win7:

Codice: Seleziona tutto

    Set WSShell = CreateObject("WScript.Shell")
    LnkPAth = Environ("UserProfile") & "\Links\"
    Set myLink = WSShell.CreateShortcut(LnkPAth & "AA_" & mySplit(UBound(mySplit)) & ".lnk")
    myLink.TargetPath = myDir


[Anthony47]

Ho chiesto aiuto a un amico, vediamo se arriva...

[Dylan666]

Ecco l'aiuto!
A quanto pare il Quick Access di Windows 10 (intesa come la lista di elementi sotto la stellina nella barra laterale a sinistra in ogni cartella di Windows) non può essere manipolato come si faceva ad esempio con il vecchio Quick Launch di Windows XP (che era a tutti gli effetti una cartella con dentro dei collegamenti).

Per "pinnnare" una cartella in quella lista si deve usare un apposito comando:

Codice: Seleziona tutto

CreateObject("Shell.Application").Namespace("c:\tmp").Self.InvokeVerb("pintohome")

Sostituite il "C:\tmp" con il percorso che desiderate

Ovviamente non è tutta farina del mio sacco, quindi lascio un link di riferimento:
https://stackoverflow.com/questions/300 ... cess-panel

[Anthony47]

Grazie Dylan, mi hai salvato...

La parte del progetto "Navigatore" da modificare e' questa:

Codice: Seleziona tutto

'... (altro)
Else
    myDir = lPath
End If
mySplit = Split(myDir, "\", , vbTextCompare)

If UBound(mySplit, 1) > 0 Then
    Set WSShell = CreateObject("WScript.Shell")
    LnkPAth = Environ("UserProfile") & "\Links\"
    Set myLink = WSShell.CreateShortcut(LnkPAth & "AA_" & mySplit(UBound(mySplit)) & ".lnk")
    myLink.TargetPath = myDir
    myLink.Save
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = mySplit(UBound(mySplit))
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = Now
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 2).Resize(1, 2).ClearContents
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 5).Value = myDir      'Log link path
    Set WSShell = Nothing
End If
'... (altro codice)


Ci arriviamo con in myDir il percorso da inserire nei Preferiti (o Accesso rapido, o "Pinned path").
Col suggerimento di Dylan diventerebbe:

Codice: Seleziona tutto

Else
    myDir = lPath
End If
mySplit = Split(myDir, "\", , vbTextCompare)
'
If UBound(mySplit, 1) > 0 Then
'    Set WSShell = CreateObject("WScript.Shell")
'    LnkPAth = Environ("UserProfile") & "\Links\"
'    Set myLink = WSShell.CreateShortcut(LnkPAth & "AA_" & mySplit(UBound(mySplit)) & ".lnk")
'    myLink.TargetPath = myDir
'    myLink.Save
    CreateObject("Shell.Application").Namespace(myDir).Self.InvokeVerb ("pintohome")
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = mySplit(UBound(mySplit))
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = Now
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 2).Resize(1, 2).ClearContents
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 5).Value = myDir      'Log link path
'    Set WSShell = Nothing
End If


Le righe commentate sono quelle sostituite, quindi possono essere eliminate
Cosi' pero' funzionerebbe solo su Win 10 e non su Win 7

Se hai la necessita' di lavorare su ambienti variegati, possiamo osare una versione anfibia, del tipo:

Codice: Seleziona tutto

Else
    myDir = lPath
End If
mySplit = Split(myDir, "\", , vbTextCompare)
'
Dim OSi As Object, wVer As String            'MEGLIO SE IN TESTA ALLA SUB
'Cerco la versione di OS:
Set OSi = GetObject("winmgmts:").ExecQuery("Select * from Win32_OperatingSystem").Itemindex(0)
wVer = OSi.Caption
'
If UBound(mySplit, 1) > 0 Then
    If InStr(1, wVer & "  ", "Windows 10", vbTextCompare) = 0 Then
        Set WSShell = CreateObject("WScript.Shell")
        LnkPAth = Environ("UserProfile") & "\Links\"
        Set myLink = WSShell.CreateShortcut(LnkPAth & "AA_" & mySplit(UBound(mySplit)) & ".lnk")
        myLink.TargetPath = myDir
        myLink.Save
        Set WSShell = Nothing
    Else
        CreateObject("Shell.Application").Namespace(myDir).Self.InvokeVerb ("pintohome")
    End If
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = mySplit(UBound(mySplit))
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = Now
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 2).Resize(1, 2).ClearContents
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 5).Value = myDir      'Log link path
End If


Questa versione pero' non ho chance di verificarla, perche' per una serie di situazioni mi son trovato solo con Win 10 anche sulle macchine meno recenti

Ciao a tutti

[wallace&gromit]

Grazie ad entrambi!
Il primo passo è fatto, ora bisogna potere fare anche il passo in dietro: quando inserisco un nuovo link dovrebbe cancellare quello creato in precedenza.
Viene gestito dalla funzione delLink, che per il momento contiene ancora le vecchie indicazioni.
Ho provato a dare un'occhiata alla pagina linkata da Dylan, ma non ne vengo a capo!
Il secondo passo in avanti sarà invece quello di fare apparire il testo del link inserito nella textbox1 della userForm.

L'ambiente anfibio non mi interessa, mi sono buttato a pesce nel windows10, in cui rimarrò immerso fino a nuovo avviso.

[Anthony47]

Eh, bisogna tyrovare quale e' l'opposto di "pintohome"
Cerco anche io, ma spero che Dylan passi ancora da queste parti...

[Dylan666]

Io ci sono ma non so come trasformare questo Powershell in VBS:

Codice: Seleziona tutto

$QuickAccess = New-Object -ComObject shell.application
($QuickAccess.Namespace("shell:::{679f85cb-0220-4080-b29b-5540cc05aab6}").Items() | where {$_.Path -eq "C:\tmp"}).InvokeVerb("unpinfromhome")

Ho porovato con:

Codice: Seleziona tutto

CreateObject("Shell.Application").Namespace("shell:::{679f85cb-0220-4080-b29b-5540cc05aab6}").Items() | where {$_.Path -eq "C:\tmp"}.InvokeVerb("unpinfromhome")

Ma il carattere pipe non gli piace e non saprei che fare... ho un dubbio anche su come ho messo le parentesi

[Anthony47]

Dopo 100 tentativi sono arrivato a questa discussione: https://www.autohotkey.com/boards/viewtopic.php?t=72293
Dopo altre 100 prove sono arrivato a questo snippet:

Codice: Seleziona tutto

Dim AShell As Object, FItm As Object
'
'
Set AShell = CreateObject("Shell.Application").Namespace("shell:::{679f85cb-0220-4080-b29b-5540cc05aab6}").Items()
For Each FItm In AShell
    Debug.Print FItm.Path
    If FItm.Path = myDir Then
        FItm.InvokeVerb ("unpinfromhome")
        Exit For
    End If
Next FItm
Set AShell = Nothing


Bisogna arrivarci con in myDir il percorso da eliminare; pero' non sono riuscito a capire rapidamente nel codice originale dove va inserito (in sostituzione di cosa); e purtroppo in questi giorni non riesco a ricreare l'ambiente di prova

Insomma per una proposta piu' concreta ho bisogno di tempo...

Ciao

[wallace&gromit]

Mah, ci ho provato, ma senza molto successo, ecco qui lo script completo (con il mio tentativo di inserire il tuo ultimo codice).

Codice: Seleziona tutto

Public notN As Boolean
Dim myEsito As Boolean
Sub CreaLink(ByVal lPath As String)
Dim myLink, WSShell, LnkPAth, MyAdr As String, myDir, mySplit
'MyAdr = ThisWorkbook.Path & ThisWorkbook.Name

Call LinkList

Call DelLink

If lPath = "" Then
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path
        .AllowMultiSelect = False
        .Title = "..Seleziona la directory di lavoro..."
        .ButtonName = "Link da inserire"
        .InitialView = msoFileDialogViewProperties
        .InitialFileName = ""
        .Show
        If .SelectedItems.Count < 1 Then
            UserForm3.Label1.Caption = "Nessuna selezione; aborted!"
            UserForm3.Show
            Exit Sub
        End If
        myDir = .SelectedItems(1)
    End With
Else
    myDir = lPath
End If
mySplit = Split(myDir, "\", , vbTextCompare)
Call TrovaMand(myDir, Mand)   'aggiunto da Marco per ricavare il numero di mandato

If UBound(mySplit, 1) > 0 Then
'    Set WSShell = CreateObject("WScript.Shell")             ' win7
'    LnkPAth = Environ("UserProfile") & "\Links\"
'    Set myLink = WSShell.CreateShortcut(LnkPAth & "AA_" & mySplit(UBound(mySplit)) & ".lnk")
'    myLink.TargetPath = myDir
'    myLink.Save                                              ' fine win7
    CreateObject("Shell.Application").Namespace(myDir).Self.InvokeVerb ("pintohome") 'nuovo per win10
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = mySplit(UBound(mySplit))
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = Now
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 2).Resize(1, 2).ClearContents
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 4).Value = Mand       'aggiunto da marco
    Foglio1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 5).Value = myDir      'Log link path

    Set WSShell = Nothing
End If
Call LinkList
If UBound(mySplit, 1) > 0 Then myMess = "Inserito nuovo link" Else myMess = "Link non valido!"

UserForm3.Label1.Caption = myMess
UserForm3.Show
notN = True
UserForm1.ComboBox1.Text = "ZC_Zc"
notN = False
   


End Sub

Sub DelLink()
'Dim myCLnk As String, LnkPAth          'win7
'Set WSShell = CreateObject("WScript.Shell")
'LnkPAth = Environ("UserProfile") & "\Links\"
'Set WSShell = Nothing

'myCLnk = Dir(LnkPAth & "AA_*")
'Do
'myEsito = False
'    If myCLnk <> "" Then
'        Call TrackEnd(myCLnk)
'        If myEsito Then Kill LnkPAth & myCLnk
'    Else
'        Exit Do
'    End If
'    DoEvents
'    myCLnk = Dir
'Loop                                         ' fine win7

Dim AShell As Object, FItm As Object           'win10
'
'
Set AShell = CreateObject("Shell.Application").Namespace("shell:::{679f85cb-0220-4080-b29b-5540cc05aab6}").Items()
For Each FItm In AShell
    Debug.Print FItm.Path
    If FItm.Path = myDir Then
        FItm.InvokeVerb ("unpinfromhome")
        Exit For
    End If
Next FItm
Set AShell = Nothing                          ' fine win10

Call LinkList


End Sub
Sub LinkList()

Dim myCLnk As String, LnkPAth, ListLnk As String

Set WSShell = CreateObject("WScript.Shell")
LnkPAth = Environ("UserProfile") & "\Links\"
myCLnk = Dir(LnkPAth & "AA_*")
Do
    If myCLnk <> "" Then
        ListLnk = ListLnk & myCLnk & vbCrLf
    Else
        Exit Do
    End If
    DoEvents
    myCLnk = "": On Error Resume Next
    myCLnk = Dir
    On Error GoTo 0
Loop
If Len(ListLnk) < 3 Then ListLnk = " ...Vuoto... "
UserForm1.TextBox1.Text = ""
UserForm1.TextBox1.Text = ListLnk
UserForm1.TextBox1.SelStart = 0
Set WSShell = Nothing

End Sub

Sub TrackEnd(ByVal CLink As String)
ThisWorkbook.Activate
With Foglio1
    For I = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If .Cells(I, 1).Value & ".lnk" = Replace(CLink, "AA_", "", 1, , vbTextCompare) Then
            If .Cells(I, 3) = "" Then
                .Cells(I, 3).Value = Now
                .Cells(I, 4).Value = Cells(I, 3) - .Cells(I, 2)
                .Cells(I, 7).Value = (Cells(I, 3) - .Cells(I, 2)) * 24 'aggiunto da marco
        myEsito = True
            End If
            Exit For
        End If
    Next I
End With
'
End Sub

Sub UF2Scarica()
Unload UserForm2
End Sub

Sub UF3Scarica()
Unload UserForm3
End Sub



Sono cosciente che la parte in cui crea la lista non può funzionare, visto che si aggancia alla modalità win7, ma, come detto, quello è un passaggio successivo.

Però ho un dubbio da profano: nella difficoltà di cancellare i link creati non può c'entrare qualcosa il fatto che, se fatti con pintohome hanno un simbolo di puntina ("pin") appunto e finiscono assieme alle cartelle principali di sistema, mentre quelli che vengono generati dal sistema non ce l'hanno?

[Dylan666]

Però ho un dubbio da profano: nella difficoltà di cancellare i link creati non può c'entrare qualcosa il fatto che, se fatti con pintohome hanno un simbolo di puntina ("pin") appunto e finiscono assieme alle cartelle principali di sistema, mentre quelli che vengono generati dal sistema non ce l'hanno?

Quelli senza "puntina" si creano in automatico quando li usi di frequente (tipo il vecchio "Documenti Recenti" di XP).
Quelli CON la "puntina" sono quelli aggiunti volontariamente a mano, ad esempio cliccando col destro su una cartella e selezionando "Aggiungi a Accesso Rapido" o trascinando la cartella in quella lista.
Noi dobbiamo per forza usare la strada CON la puntina.

Ma dal punto di vista informatico una cosa è dire "aggiungi mela alla lista frutta" e un'altra è "scorri tutta la lista frutta e se l'elemento si chiama mela cancellalo". Noi stiamo facendo questa seconda parte

[Anthony47]

Lo snippet pubblicato cancella dall'elenco quanto e' descritto nella variabile myDir; ho usato quanto ho scritto ieri e oggi per aggiungere una voce Pinned e per eliminarla.

Ora io lo so che, risolto il delisting (quando sara' risolto), verra' a galla che il codice con cui creavo l'elenco dei preferiti non funziona nemmeno quello.
Insomma mi devo ricreare l'ambiente di lavoro e riguardare il tutto

Mi aiuterebbe anche sapere se e' utile prevedere l'ambiente anfibio (win7 e win 10) o se basta lavorare su win 10

Ciao

[Dylan666]

Mi aiuterebbe anche sapere se e' utile prevedere l'ambiente anfibio (win7 e win 10) o se basta

L'ambiente anfibio non mi interessa, mi sono buttato a pesce nel windows10, in cui rimarrò immerso fino a nuovo avviso.

[wallace&gromit]

Grazie Dylan, hai anticipato la mia risposta.

il vecchio "Documenti Recenti" di XP

lacrimuccia per l'amato XP.

Quando tutto funziona bene il nome dell'ultimo link creato figura nell'ultima riga della tabella del foglio1. Può aiutare nella ricerca "delle mele"?

[Anthony47]

Che fate, vi coalizzate?
Niente, devo ricreare l'ambiente di lavoro e riguardare il tutto

Ciao!

[wallace&gromit]

Io coalizzarmi con qualcuno contro il mio guru? Ma neanche me lo chiedessero Bill Gates, Salvatore Aranzulla e Chuck Norris uniti.

[Anthony47]

[wallace&gromit]

Anthony, non dannarti l'anima, soprattutto non a Natale!
La soluzione legata alla versione di Win7 è comunque funzionante, c'è semplicemente da fare un passaggio in più, perché la cartella attiva appare sotto Accesso rapido/collegamenti.