Code Snippet
'Copiar arquivo do profile do user para o caminho UNC do servidor
'Por Leonardo Couto Conrado
'18.07.2008
'Option Explicit
'On error Resume Next
Dim Computers, CopyThisFile, ObjComput, Path, NameFile, objShell, objFolder, objFolderItem,StrUserName, strComputer,TestPath
Const OverwriteExisting = True
Set ObjNetwork = CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Computer = ObjNetwork.ComputerName
User = ObjNetwork.UserName
Profile
NameFile = "Arquivo_Teste.txt" 'Indique o nome do arquivo que precisa ser copiado
Destino = "\\servidor\user\" 'Indique o caminho da pasta no servidor a subpasta com o nome do PC será criado automaticamente
PutBar Destino
PathFile = Path & "\"& NameFile
DestinoComp = Destino & Computer
If (objFSO.FolderExists(DestinoComp)) Then
If (objFSO.FileExists(DestinoComp & "\" & NameFile)) Then
Wscript.Quit 'Se o arquivo exite no diretorio destino encerre o script ele não sobre escreve o arquivo
Else
PutBar DestinoComp
objFSO.CopyFile PathFile, DestinoComp
End if
Else
Set CreateFolderD = objFSO.CreateFolder(Destino & "\" & Computer)
PutBar DestinoComp
objFSO.CopyFile PathFile, DestinoComp
End if
Function PutBar(TestPath)
If Right( TestPath, 1 ) <> "\" Then
TestPath = TestPath & "\"
End If
End Function
Function Profile()
Const Profile_User = &H28&
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(Profile_User)
Set objFolderItem = objFolder.Self
Path = objFolderItem.Path 'Este caminho é o do perfil do usuário Ex: "C:\documents and settings\leonardo.conrado"
End Function