Ciao Giuseppe,
certamente vi do più info possibili per creare questo codice.
Iniziamo dal folgio excel, ho una matrice dati impostata in questo modo:
| MAR |
|
446013 |
Navigational Watch Rating |
Beljajev Artur |
| MAR |
|
446013 |
Navigational Watch Rating |
NAZARETH Ariel Lorenzana |
| MAR |
|
446013 |
Navigational Watch Rating |
Tilburn Nathan |
| MAR |
|
446013 |
Navigational Watch Rating |
Adams Rajap |
| MAR |
|
446013 |
Navigational Watch Rating |
Solomons Leonard Clint |
| MAR |
|
446013 |
Navigational Watch Rating |
JUMAOAS Christopher |
| MAR |
|
446013 |
Navigational Watch Rating |
BAISA Pepito Tabang |
| MAR |
OUT |
446013 |
Navigational Watch Rating |
MONDARES Romel Pugnaria |
per ognuna delle persone in matrice, ho una cartella dedicata (intitolata con colonna "D:E" ) con all'interno tutti i certificati che la persona possiede.
Vorrei, tramite codice, ppoter aggiungere ad ogni certificato della cartella il nome e cognome del proprietario del certificato.
Quindi secondo me una cosa del genere:
Cliccare sulla persona interessata, cercare la cartella che abbia lo stesso nome della colonna "D" e colonna "E" selezionale la cartella e modificare tutti i file all'interno di essa aggiungendo già al nome esistente solo la colonna "E" cioè il nome e cognome del proprietario del certificato.
Ad esempio se seleziono la prima persona della lista:
Navigational Watch Rating Beljajev Artur vado a puntare alla sua cartella che si trova nel mio caso in :
O:\VESSEL\STRN-DCS-DB\GE-DC-Document-Control\GE-DC 23 Matrix\Matrix\Personnel Certificates*Navigational Watch Rating Beljajev Artur*
a questo punto dovrei entrate nella cartella selezionata e modificare tutti i file in essa (PDF & JPEG) aggiungendo al nome del certificato stesso il nome del proprietario e cioè:
Confined Space Entry certificate
diventerà
Confined Space Entry certificate Beljajev Artur
Prova qualcosa del genere:
'========>>
Option Explicit
Option Compare Text
'-------->>
Public Sub Tester()
Dim oFSO As Object
Dim oFolder As Object, oSubFolder As Object, ofile As Object
Dim WB As Workbook
Dim srcSH As Worksheet
Dim srcRng As Range
Dim arrIn As Variant
Dim sSeparator As String
Dim sOldName As String, sNewName As String, sSuffix As String
Dim LRow As Long
Dim i As Long
Const sDirectory As String ="O:\VESSEL\STRN-DCS-DB\GE-DC-Document-Control\GE-DC 23 Matrix\Matrix\Personnel Certificates\"
Const sFoglio\_Sorgente As String = **"Foglio1" '<<=== Modifica**
Const iPrima\_Riga As Long = **2 '<<=== Modifica**
Set WB = ThisWorkbook
Set srcSH = WB.Sheets(sFoglio\_Sorgente)
With srcSH
LRow = LastRow(srcSH, .Columns("A"))
Set srcRng = .Range("A" & iPrima\_Riga).Resize(LRow - iPrima\_Riga + 1, 5)
End With
arrIn = srcRng.Value
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sDirectory)
sSeparator = Application.PathSeparator
For i = LBound(arrIn) To UBound(arrIn)
Set oSubFolder = oFSO.GetFolder(sDirectory & sSeparator & arrIn(i, 4) & Space(1) & arrIn(i, 5))
For Each ofile In oSubFolder.Files
sOldName = Split(ofile.Name, ".")(0)
sSuffix = Split(ofile.Name, ".")(1)
If sSuffix = "JPEG" Or sSuffix = "PDF" Then
sNewName = oSubFolder & sSeparator & sOldName & Space(1) & arrIn(i, 5) & "." & sSuffix
Name ofile.Path As sNewName
End If
Next ofile
Next i
Call MsgBox(Prompt:="Finito!", \_
Buttons:=vbInformation, \_
Title:="REPORT!")
End Sub
'--------->>
Public Function LastRow(SH As Worksheet, _
Optional Rng As Range, \_
Optional minRow As Long = 1)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If
On Error Resume Next
LastRow = Rng.Find(What:="\*", \_
After:=Rng.Cells(1), \_
Lookat:=xlPart, \_
LookIn:=xlFormulas, \_
SearchOrder:=xlByRows, \_
SearchDirection:=xlPrevious, \_
MatchCase:=False).Row
On Error GoTo 0
If LastRow < minRow Then
LastRow = minRow
End If
End Function
'<<========
===
Regards,
Norman
