Thanks for your reply!
This is the macro I have now based on your macros:
Code:
Option Explicit
Sub Rename_Folder()
Dim oFSO As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim i As Integer
Dim strpath As String
Dim strSubFolderPath As String
Dim strSubFolderNewName As String
Dim fisword As String
Dim FOLDER As String
Dim primit As String
Dim cinci As String
Dim cinci1 As String
Dim raport As String
Dim BAAR As String
Dim nr As String
Dim MARCA As String
Dim data As String
Dim anexa1 As String
Dim anexa5 As String
Dim AUDATEX As String
Dim nr1 As String
Dim marca1 As String
Dim anexa4 As String
Dim strName As String
Dim fso As Object
Dim oDoc As Document
Dim strName1 As String
Dim strmessage As String
Const strDrive As String = "D:\MIHAI\DOSARE\BAAR\"
raport = Trim(ActiveDocument.BuiltInDocumentProperties("Title").Value)
BAAR = Replace(Trim(ActiveDocument.BuiltInDocumentProperties("keywords").Value), "/", ".") & Chr(32)
nr = Replace(Trim(ActiveDocument.BuiltInDocumentProperties("Company").Value), Chr(150), "")
MARCA = ActiveDocument.BuiltInDocumentProperties("Comments").Value
nr1 = Replace(Trim(ActiveDocument.BuiltInDocumentProperties("Company").Value), Chr(150), "-")
marca1 = MARCA & ", " & nr1
data = ActiveDocument.BuiltInDocumentProperties("Content status").Value
cinci = Right(Replace(Trim(ActiveDocument.BuiltInDocumentProperties("keywords").Value), "/", ".") & Chr(32), 6)
cinci1 = Replace(cinci, " ", "")
primit = "BAAR-Dosarxxx" & "_" & cinci1 & "-" & data & " Mihai"
fisword = "R" & raport & "_" & BAAR & nr & " " & MARCA
FOLDER = "BAAR-Dosarxxx" & raport & "_" & cinci1 & " " & nr & " " & MARCA & "-" & data & " Mihai FIN"
anexa1 = "Anexa4_R" & raport & "_" & "DevizAudatex " & nr
anexa5 = "Anexa5_R" & raport & "_" & "Evaluare auto " & nr
Selection.Font.Bold = True
anexa4 = "Anexa4"
Selection.Font.Bold = False
strpath = "D:\MIHAI\DOSARE\BAAR"
strSubFolderNewName = strDrive & FOLDER
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(strpath)
For Each oSubFolder In oFolder.SubFolders
If Not oSubFolder.Name Like "MICHAEL_*" Then 'Optional
strSubFolderPath = oSubFolder.Path
Name strSubFolderPath As strSubFolderNewName
Exit For
End If 'Optional
Next oSubFolder
Set oFSO = Nothing
Set oFolder = Nothing
Set oSubFolder = Nothing
FileCopy strDrive & "RP.vcp", strDrive & FOLDER & "\RP.vcp"
strmessage = "Raport de verif pt. dosar " & BAAR & vbCr & _
"In atentia " & strName1 & " " & strName & "," & vbCr & _
"Urmare a verificarii dosarului " & BAAR & " auto pagubit marca " & MARCA & _
"va transmitem atasat raportul de verificare." & vbCr & _
"Rog confirmati primirea." & vbCr & _
"Cu stima," & vbCr & vbCr & _
"Mihai STAICU"
Const STRPAT As String = strSubFolderNewName
Set fso = CreateObject("Scripting.FileSystemObject")
Select Case True
Case fso.FileExists(STRPAT & "Mail AU.docx")
Set oDoc = Documents.Add(Template:=STRPAT & "Mail AU.docx")
strName = "Adrian Uta"
strName1 = "d-lui"
oDoc.Range.Text = strmessage
oDoc.SaveAs2 FileName:=STRPAT & "AU.docx", addtorecentfiles:=False
Case fso.FileExists(STRPAT & "Mail CT.docx")
Set oDoc = Documents.Add(Template:=STRPAT & "Mail EN.docx")
strName = "Cristi Turcu"
strName1 = "d-lui"
oDoc.Range.Text = strmessage
oDoc.SaveAs2 FileName:=STRPAT & "CT.docx", addtorecentfiles:=False
Case fso.FileExists(STRPAT & "Mail EN.docx")
Set oDoc = Documents.Add(Template:=STRPAT & "Mail EN.docx")
strName = "Emilia Negoita"
strName1 = "d-nei"
oDoc.Range.Text = strmessage
oDoc.SaveAs2 FileName:=STRPAT & "EN.docx", addtorecentfiles:=False
End Select
lbl_Exit:
Set fso = Nothing
Set oDoc = Nothing
Exit Sub
End Sub
The problem is at the red line of the code. The only way it will work is if I use a constant but I need the path to be strSubFolderNewName (because here is the initial docx file Mail AU.docx, Mail CT.docx or Mail EN.docx). Somehow I need to turn strSubFolderNewName into a constant that I can use.
So how can I assign that to a constant ?