Boa Tarde Amigos
Estou com uma dúvida que acredito que para vcs é simples, porem estou tendo dificultades....
Tenho o código abaixo em um mod global e tem como objetivo criar uma pasta em um determinado diretorio e copiar um arquivo .docm para dentro desta pasta atribuindo um novo nome....
a função abaixo funciona corretamento, porem gostaria de atribuir o nome desta .docm com data atual do computador....
ex: "04052012.docm"
hoje na programação ela é renomeada como "Data.docm" (Destaque em Vermelho)
Mas gostaria de implementar esse código.......
alguem pode me ajudar nessa?
==============================================================================
Option Compare Database
Option Explicit
Public Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) _
As Long
Public Const FO_COPY As Long = &H2
Public Const FOF_ALLOWUNDO As Long = &H40
Public Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Public Sub CopiarArq(Origem As String, Destino As String)
Dim RST As Long
Dim FLOP As SHFILEOPSTRUCT
FLOP.hWnd = 0
FLOP.wFunc = FO_COPY
FLOP.pFrom = Origem & vbNullChar & vbNullChar
FLOP.pTo = Destino & vbNullChar & vbNullChar
FLOP.fFlags = FOF_ALLOWUNDO
RST = SHFileOperation(FLOP)
If RST <> 0 Then
MsgBox err.LastDllError, vbCritical Or vbOKOnly
Else
If FLOP.fAnyOperationsAborted <> 0 Then
MsgBox "Falha na cópia!!!", vbCritical Or vbOKOnly
End If
End If
End Sub
Public Function fncCopiar_G1Industria()
Dim fso As New FileSystemObject
If Not fso.FolderExists("C:\Propostas_G1\Nova_Proposta") = True Then ' Verifica se a pasta existe.
fso.CreateFolder ("C:\Propostas_G1\Nova_Proposta") ' caso não exista, cria a pasta
End If
CopiarArq "C:\Propostas_G1\Proposta G1 Industria.docm", "C:\Propostas_G1\Nova_Proposta\"
Name "C:\Propostas_G1\Nova_Proposta\Proposta G1 Industria.docm" As "C:\Propostas_G1\Nova_Proposta\Data.docm"
End Function
Estou com uma dúvida que acredito que para vcs é simples, porem estou tendo dificultades....
Tenho o código abaixo em um mod global e tem como objetivo criar uma pasta em um determinado diretorio e copiar um arquivo .docm para dentro desta pasta atribuindo um novo nome....
a função abaixo funciona corretamento, porem gostaria de atribuir o nome desta .docm com data atual do computador....
ex: "04052012.docm"
hoje na programação ela é renomeada como "Data.docm" (Destaque em Vermelho)
Mas gostaria de implementar esse código.......
alguem pode me ajudar nessa?
==============================================================================
Option Compare Database
Option Explicit
Public Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) _
As Long
Public Const FO_COPY As Long = &H2
Public Const FOF_ALLOWUNDO As Long = &H40
Public Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Public Sub CopiarArq(Origem As String, Destino As String)
Dim RST As Long
Dim FLOP As SHFILEOPSTRUCT
FLOP.hWnd = 0
FLOP.wFunc = FO_COPY
FLOP.pFrom = Origem & vbNullChar & vbNullChar
FLOP.pTo = Destino & vbNullChar & vbNullChar
FLOP.fFlags = FOF_ALLOWUNDO
RST = SHFileOperation(FLOP)
If RST <> 0 Then
MsgBox err.LastDllError, vbCritical Or vbOKOnly
Else
If FLOP.fAnyOperationsAborted <> 0 Then
MsgBox "Falha na cópia!!!", vbCritical Or vbOKOnly
End If
End If
End Sub
Public Function fncCopiar_G1Industria()
Dim fso As New FileSystemObject
If Not fso.FolderExists("C:\Propostas_G1\Nova_Proposta") = True Then ' Verifica se a pasta existe.
fso.CreateFolder ("C:\Propostas_G1\Nova_Proposta") ' caso não exista, cria a pasta
End If
CopiarArq "C:\Propostas_G1\Proposta G1 Industria.docm", "C:\Propostas_G1\Nova_Proposta\"
Name "C:\Propostas_G1\Nova_Proposta\Proposta G1 Industria.docm" As "C:\Propostas_G1\Nova_Proposta\Data.docm"
End Function