Hi guys!



I have this macro:

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


Const strDrive As String = "D:\MIHAI\DOSARE\BAAR\"

raport = Trim(ActiveDocument.BuiltInDocumentProperties("Tit le").Value)
BAAR = Replace(Trim(ActiveDocument.BuiltInDocumentPropert ies("keywords").Value), "/", ".") & Chr(32)
nr = Replace(Trim(ActiveDocument.BuiltInDocumentPropert ies("Company").Value), Chr(150), "")
marca = ActiveDocument.BuiltInDocumentProperties("Comments ").Value
nr1 = Replace(Trim(ActiveDocument.BuiltInDocumentPropert ies("Company").Value), Chr(150), "-")
marca1 = marca & ", " & nr1
data = ActiveDocument.BuiltInDocumentProperties("Content status").Value
cinci = Right(Replace(Trim(ActiveDocument.BuiltInDocumentP roperties("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
lbl_Exit:
Set oFSO = Nothing
Set oFolder = Nothing
Set oSubFolder = Nothing
Exit Sub
End Sub

Can anyone help me to add a code in the macro to copy a file named rp.vcp from the folder D:\MIHAI\DOSARE\BAAR to the new renamed folder D:\MIHAI\DOSARE\BAAR\strSubFolderNewName and also keep the original file ?

Any ideas ? Thanks a lot!

The macro (use the code button - # - to format your codes), which is very loosely based on a macro I helped you with, in response to an earlier question.

You have filled a load of string variables from values (that hopefully exist - though there is no error checking), some of which have no apparent purpose, although IO have not delved too deeply, and you have assigned your default path to two separate variables?

Without referring back to the original macro to check, I seem to recall that the process there renamed a sub folder if it existed?

If there is a file in your folder defined at strpath and strdrive called rp.vcp then it can be copied easily enough using the command

__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com

Thanks a lot man.
The macro is based on the macro you helped me earlier.
Actually I use two macros you helped me with. I dont'k know how to merge them into 1.

Macro nr. 1 to rename folder and copy RP.vcp

#
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


Const strDrive As String = "D:\MIHAI\DOSARE\BAAR\"

raport = Trim(ActiveDocument.BuiltInDocumentProperties("Tit le").Value)
BAAR = Replace(Trim(ActiveDocument.BuiltInDocumentPropert ies("keywords").Value), "/", ".") & Chr(32)
nr = Replace(Trim(ActiveDocument.BuiltInDocumentPropert ies("Company").Value), Chr(150), "")
marca = ActiveDocument.BuiltInDocumentProperties("Comments ").Value
nr1 = Replace(Trim(ActiveDocument.BuiltInDocumentPropert ies("Company").Value), Chr(150), "-")
marca1 = marca & ", " & nr1
data = ActiveDocument.BuiltInDocumentProperties("Content status").Value
cinci = Right(Replace(Trim(ActiveDocument.BuiltInDocumentP roperties("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
lbl_Exit:
Set oFSO = Nothing
Set oFolder = Nothing
Set oSubFolder = Nothing

FileCopy strDrive & "RP.vcp", strDrive & FOLDER & "\RP.vcp"
Exit Sub

End Sub
#

Macro nr 2.

#
Option Explicit
Sub BAAR()

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
MkDir "D:\MIHAI\DOSARE\BAAR\X"

Const strDrive As String = "D:\MIHAI\DOSARE\BAAR\"

raport = Trim(ActiveDocument.BuiltInDocumentProperties("Tit le").Value)
BAAR = Replace(Trim(ActiveDocument.BuiltInDocumentPropert ies("keywords").Value), "/", ".") & Chr(32)
nr = Replace(Trim(ActiveDocument.BuiltInDocumentPropert ies("Company").Value), Chr(150), "")


marca = ActiveDocument.BuiltInDocumentProperties("Comments ").Value
nr1 = Replace(Trim(ActiveDocument.BuiltInDocumentPropert ies("Company").Value), Chr(150), "-")

marca1 = marca & ", " & nr1
data = ActiveDocument.BuiltInDocumentProperties("Content status").Value
cinci = Right(Replace(Trim(ActiveDocument.BuiltInDocumentP roperties("keywords").Value), "/", ".") & Chr(32), 6)
cinci1 = Replace(cinci, " ", "")

primit = "BAAR-Dosarxxx" & "_" & cinci1 & "-" & data & " Mihai"
fisword = "R" & raport & "_" & BAAR & nr & " " & marca
'folder = "BAAR-Dosar" & raport & "_" & cinci1 & " " & nr & " " & marca & "-" & data
FOLDER = "BAAR-Dosarxxx" & raport & "_" & cinci1 & " " & nr & " " & marca & "-" & data & " Mihai FIN"
'Name strDrive & primit As strDrive & folder
anexa1 = "Anexa4_R" & raport & "_" & "DevizAudatex " & nr
anexa5 = "Anexa5_R" & raport & "_" & "Evaluare auto " & nr

Selection.Font.Bold = True
anexa4 = "Anexa4"
Selection.Font.Bold = False

AUDATEX = anexa4 & " - Calcula" & ChrW(539) & "ie deviz de repara" & ChrW(539) & "ii pentru auto " & marca & " cu nr. de înmatriculare " & ActiveDocument.BuiltInDocumentProperties("Company" ).Value

ActiveDocument.SaveAs2 strDrive & "_" & fisword & ".docx"
'ActiveDocument.ExportAsFixedFormat OutputFileName:=strDrive & fisword & ".pdf", _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, From:=1, TO:=1, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateHeadingBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False

'ActiveDocument.SaveAs2 strDrive & fisword & ".docx"
'ActiveDocument.ExportAsFixedFormat OutputFileName:=strDrive & fisword & ".pdf", _
'ExportFormat:=wdExportFormatPDF, _
'OpenAfterExport:=False, _
'OptimizeFor:=wdExportOptimizeForPrint, _
'Range:=wdExportAllDocument, From:=1, TO:=1, _
'Item:=wdExportDocumentContent, _
'IncludeDocProps:=True, _
'KeepIRM:=True, _
'CreateBookmarks:=wdExportCreateHeadingBookmarks, _
'DocStructureTags:=True, _
'BitmapMissingFonts:=True, _
'UseISO19005_1:=False

ActiveDocument.SaveAs2 FileName:=strDrive & fisword & ".doc", FileFormat:=wdFormatDocument


'ActiveDocument.ExportAsFixedFormat OutputFileName:=strDrive & FOLDER & ".pdf", _
'ExportFormat:=wdExportFormatPDF, _
'OpenAfterExport:=False, _
'OptimizeFor:=wdExportOptimizeForPrint, _
'Range:=wdExportAllDocument, From:=1, TO:=1, _
'Item:=wdExportDocumentContent, _
'IncludeDocProps:=True, _
'KeepIRM:=True, _
'CreateBookmarks:=wdExportCreateHeadingBookmarks, _
'DocStructureTags:=True, _
'BitmapMissingFonts:=True, _
'UseISO19005_1:=False

ActiveDocument.ExportAsFixedFormat OutputFileName:=strDrive & "_" & anexa1 & ".pdf", _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, From:=1, to:=1, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateHeadingBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False

ActiveDocument.ExportAsFixedFormat OutputFileName:=strDrive & "_" & anexa5 & ".pdf", _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, From:=1, to:=1, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateHeadingBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False

ActiveDocument.ExportAsFixedFormat OutputFileName:=strDrive & "_" & AUDATEX & ".pdf", _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, From:=1, to:=1, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateHeadingBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False

ActiveDocument.ExportAsFixedFormat OutputFileName:=strDrive & "_" & marca1 & ".pdf", _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, From:=1, to:=1, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateHeadingBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False

'ActiveDocument.ExportAsFixedFormat OutputFileName:=strDrive & ",trimis R" & raport & "_" & Right(BAAR, 6) & ".pdf", _
'ExportFormat:=wdExportFormatPDF, _
'OpenAfterExport:=False, _
'OptimizeFor:=wdExportOptimizeForPrint, _
'Range:=wdExportAllDocument, From:=1, TO:=1, _
'Item:=wdExportDocumentContent, _
'IncludeDocProps:=True, _
'KeepIRM:=True, _
'CreateBookmarks:=wdExportCreateHeadingBookmarks, _
'DocStructureTags:=True, _
'BitmapMissingFonts:=True, _
'UseISO19005_1:=False

lbl_Exit:

With Application
.ScreenUpdating = False
'Loop Through open documents
Do Until .Documents.Count = 0
'Close no save
.Documents(1).Close SaveChanges:=wdDoNotSaveChanges
Loop

'Quit Word no save
.Quit SaveChanges:=wdDoNotSaveChanges
End With

Exit Sub
End Sub
#

I don't know how it works but it does so thanks a lot!