Ho due cartelle excel :
salva cartella.xlsm (dove risiede la macro e la lancio)
Date.xlsx (dove voglio cercare il NomeFileCommessa e creare il link)
Da "salva cartella.xlsm" prelevo il nome della directory da creare, creo la directory e la apro
e subito dopo devo cercare il "NomeFileCommessa" nella colonna "D" della cartella excel "Date.xlsx"
e se lo trovo devo creare l'hiper-link alla directory corrispondente altrimenti messaggio link non creato.
Se faccio tutto su "salva cartella.xlsm" funziona tutto ,ma se devo modificare la stringa e cercare il dato
su "Date.xlsx" e creare l'Hiper-link....... mi impantano.
Stringa funzionante sul foglio attivo........
- Codice: Seleziona tutto
Public Sub macrocartella()
Dim objFso As Object
Dim objFolder As Object
Dim NomeFileCommessa As String
Dim sPathTI As String
Dim xCartellaTI As String
Dim UR As Integer
Application.ScreenUpdating = False
sPathTI = "C:\Users\daniele\Desktop"
NomeFileCommessa = ActiveSheet.Range("A1").Value
Set objFso = CreateObject("Scripting.FileSystemObject")
If objFso.FolderExists(sPathTI & "\" & NomeFileCommessa) Then
MsgBox "La cartella esiste"
Else
MsgBox "La cartella non esiste"
Set objFolder = objFso.CreateFolder(sPathTI & "\" & NomeFileCommessa)
MsgBox "La cartella è stata creata"
End If
'Apro la cartella appena creata
xCartellaTI = sPathTI & "\" & NomeFileCommessa
If Len(Dir(xCartellaTI, vbDirectory)) <> 0 Then
Shell "Explorer.exe /n,/e," & xCartellaTI, vbNormalFocus
Else
MsgBox "La cartella non esiste!", vbCritical
End If
'Creo l'Hyper-link
With Sheets("Foglio1")
UR = .Cells(.Rows.Count, 4).End(xlUp).Row
For n = UR To 1 Step -1
If .Cells(n, 4).Value = NomeFileCommessa Then
.Cells(n, 4).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=xCartellaTI, _
TextToDisplay:=NomeFileCommessa
End If
Next n
End With
Application.ScreenUpdating = True
Set objFolder = Nothing
Set objFso = Nothing
End Sub
grazie a chiunque dia aiuto valido !
