VBA Code to copy file to folder and keep the original.
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!
|