Kopier filer og mapper fra et netvæksdrev til et andet !

Hvis jeg ikke har forklaret mig godt nok kan i bare sige til !!

Hej

Jeg skal nok lige kigge på det i løbet af dagen :-)

VH CK

Det lyder kanont :-)

Har du set på
http://www.eksperten.dk/spm/539535.
Med meget få rettelser så burde det virke som du ønsker!

tofte >> Hvis jeg kunne lave de rettelser havde jeg ik oprettet spørgsmålet :-)

Det er ikke noget problem, rettelserne kommer her:

Jeg er ikke helt med når det gælder popupboksen, men prøv og se om det ikke er det du mener. Du skal bare gemme nedenstående som etellerandet.vbs. Og kalde filen fra en dosprompt eller kør, med 3 parametre
filnavn sek kilde dest

Sek er antal sekunder der skal gå mellem hver gang programmet undersøger for nye filer. kilde er sti til mappen som skal undersøges eks C:\test,  og dest er distinationsmappen

Option Explicit

Dim WshShell, oFS, Source, Destination, oCatalog, file, oFiles,  SleepTimer
Set WshShell = CreateObject("WScript.Shell")
Set oFS = CreateObject("Scripting.FileSystemObject")

Const ForReading = 1, ForWriting = 2, ForAppending = 8

If WScript.Arguments.Count < 2 Then
    WScript.Echo "Error in command. For Right use, type:" & vbCrLf _
    & "CScript SpotAndCopy.vbs [TIME] [Source] [Destination]" & vbCrLF & vbCrLf _
    & "EX:" & vbCrLf & "CScript SpotAndCopy.vbs 10 C:\Source C:\Destination "
    WScript.Echo SleepTimer
    WScript.Quit
End If

SleepTimer = WScript.Arguments(0)    'Time in Seconds
SleepTimer = SleepTimer * 1000
Source = WScript.Arguments(1)        '"c:\temp\Source"
Destination = WScript.Arguments(2)    '"c:\temp\Destination"


Set oCatalog = oFS.GetFolder(Source)
Set oFiles = oCatalog.Files



Do
  if (oFS.FolderExists(source) AND oFS.FolderExists(Destination)) then
    For Each file In oFiles
        If file.Size > 0 Then
            Copy(file)
        End If
    Next
   
  else
  MsgBox("Destination eller kilde kan ikke åbnes")
  WScript.Quit
  end if
  WScript.Sleep SleepTimer
Loop


WshShell = "Nothing"
oFS = "Nothing"
LogFile.Close
LogFile = "Nothing"


'---------------------------------------------------------------------
Function Copy(file)

    Dim DestinationFile, DF
 
    DestinationFile = Right(file, (Len(file)-InStrRev(file, "\", -1, vbTextCompare)))

    If Not oFS.FileExists(Destination & "\" & DestinationFile) Then
        oFS.CopyFile file, Destination & "\" & DestinationFile, True
        If Err.Number = 0 Then
            Log(DestinationFile & " Has been copied.")
        Else
            Log("Copy og file " & file & " has failed with the following message: " & Err.Description)
        End If
        Err.Clear
    Else
        Set DF = oFS.GetFile(Destination & "\" & DestinationFile)
        If file.DateLastModified <> DF.DateLastModified Then
            oFS.CopyFile file, Destination & "\" & DestinationFile, True
            If Err.Number = 0 Then
                Log(DestinationFile & " Has been copied.")
            Else
                Log("Copy og file " & file & " has failed with the following message: " & Err.Description)
            End If
            Err.Clear
        End if
    End If
 
End Function
'---------------------------------------------------------------------
Function Log(Msg)

    MsgBox Msg

End Function
'---------------------------------------------------------------------

Det var vist et svar. Håber du kan bruge det, ellers må vi jo lige rette lidt i det.

Nu fik jeg vist ikke skrevet det helt som jeg mente, med "alle filer" mente jeg mapper og undermapper osv....

Desuden duer den popup ikke, da der er tale om ca. 400 filer og gider ikke trykke ok hver gang :-)

Desuden skal det ikke køre timed men kun den ene gang man starter programmet

så har jeg kigget lidt på det. Lige et spørgsmål, skal der være en popupboks, eller er det ok med en log fil. Det er nemlig ikke muligt at lave andet end en popupboks i VB. Man kan i ren VB lave en boks som selv forsvinder efter 1 sek, og så kommer der en ny som også forsvinder .... Det er nok lidt træls hvis det er 400 filer. Hvis man skal have noget som selv skifter skal man til at indrage eks Internet Explorer!

Og lige et andet spørgsmål. Kan det tænkes at netværksforbidelsen forsvinder mens man kopierer?
option explicit
dim targetFolder,sourceFolder

sub log(msg)
    msgBox msg
end sub

sub doCopy(sourceFolder,targetFolder)
    dim folder,fileCol,folderCol,fil
    Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

    set folder = objFSO.getFolder(sourceFolder)
    set fileCol = folder.Files
    set folderCol=folder.SubFolders

    For Each fil in filecol
        if not objFSO.FileExists(targetFolder&"\"&fil.name) then
            objFSO.CopyFile SourceFolder&"\"&fil.name, targetFolder&"\"&fil.name
            log "Copying file: "&sourceFolder&"\"&fil.name
        end if
    next   
    For Each folder in folderCOl
        if not objFSO.FolderExists(targetFolder&"\"&folder.name) then
            objFSO.CreateFolder(targetFolder&"\"&folder.name)
            log "Creating folder: "&sourceFolder&"\"&folder.name

        end if
        doCopy sourceFolder&"\"&folder.name,targetFolder&"\"&folder.name   
    next   
    set fileCol = nothing
    set folderCol = nothing
    set folder = nothing
end sub
Dim objFSO,cont
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

cont = true

sourceFolder="C:\test"
targetFolder="C:\test1"

if not objFSO.FolderExists(sourceFolder) then
    msgBox("Kan ikke åbne kilde : "&sourceFolder)
    cont=false
end if

if not objFSO.FolderExists(targetFolder) then
    msgBox("Kan ikke åbne destination : "&targetFolder)
    cont=false
end if

if cont then
    doCopy sourceFolder,targetFolder
end if

bemærk det postede svar indeholder stadigt popupboksen...

Nej det er nærmest ikke nødvendig med den popup så.....

Kan du ikke lige lave så der står Kopierer når man starter scriptet, og den så forsvinder 1 sek efter scriptet er færdigt??

Forbindelsen kan måske godt forsvinde da det er trådløst netværk der er tale om......

Det er svært at lave en popup som er der hele tiden, idet programmet venter på svar fra brugeren og det fortsætter ikke før boksen forsvinder eller man trykker ok. Så nu kommer der en i starten og en til slut.

option explicit
dim targetFolder,sourceFolder

sub log(msg)
    'msgBox msg
end sub

function Chk(sourceFolder,targetFolder)
    chk=true
    if not objFSO.FolderExists(sourceFolder) then
        MsgBox("Kan ikke åbne kilde : "&sourceFolder)
        chk=false
    end if

    if not objFSO.FolderExists(targetFolder) then
        msgBox("Kan ikke åbne destination : "&targetFolder)
        chk=false
    end if
end function

sub Quit()
    MsgBox "Forbindelsen til netværket afbrudt"
    WScript.Quit
end sub

sub doCopy(sourceFolder,targetFolder)
    dim folder,fileCol,folderCol,fil
    Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

    set folder = objFSO.getFolder(sourceFolder)
    set fileCol = folder.Files
    set folderCol=folder.SubFolders

    For Each fil in filecol
        if not objFSO.FileExists(targetFolder&"\"&fil.name) then
            objFSO.CopyFile SourceFolder&"\"&fil.name, targetFolder&"\"&fil.name
            If Err.Number = 0 Then
                log "Copying file: "&sourceFolder&"\"&fil.name
            else
              Quit()
            end if
        end if
    next   
    For Each folder in folderCOl
        if not objFSO.FolderExists(targetFolder&"\"&folder.name) then
            objFSO.CreateFolder(targetFolder&"\"&folder.name)
            If Err.Number = 0 Then
                log "Creating folder: "&sourceFolder&"\"&folder.name
            else
                Quit()
            end if

        end if
        doCopy sourceFolder&"\"&folder.name,targetFolder&"\"&folder.name   
    next   
    set fileCol = nothing
    set folderCol = nothing
    set folder = nothing
end sub

Dim objFSO,cont
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

sourceFolder="C:\test"
targetFolder="C:\test1"

dim wshShell
Set WshShell = CreateObject("WScript.Shell")
WshShell.Popup "Begynder kopiering", 2, , 0

if (chk (sourceFolder,targetFolder)) then doCopy sourceFolder,targetFolder

WshShell.Popup "Kopiering afsluttet", 5, , 0

lige en rettelse til de sidste to linier
if (chk (sourceFolder,targetFolder)) then
    doCopy sourceFolder,targetFolder
    WshShell.Popup "Kopiering afsluttet", 2, , 0
end if

altså et end if til sidst og et linieskift efter then

Hov lige en sidste ting, kan du også lave så filer der ikke findes på source slettes fra destination eller er det for omfattende at komme igang med ???

Smider gerne flere points i hvis det er....

det er rimeligt meget at lave. Man kan jo slette alle filer, inden man begynder at kopiere, men så går lidt af ideen jo af det. Det er ret svært at lave det andet. Men jeg skal lige tænke over det. Der går nok lige et par dage. Da jeg har dårligt tid de næste par dage, men som sagt, det er ikke lige til.

Hmm.... okay... håber du kommer i tanke om det..

Du får lige points her indtil videre :-)

Så skulle det være klar

option explicit
dim targetFolder,sourceFolder

sub log(msg)
    'msgBox msg
end sub

function Chk(sourceFolder,targetFolder)
    chk=true
    if not objFSO.FolderExists(sourceFolder) then
        MsgBox("Kan ikke åbne kilde : "&sourceFolder)
        chk=false
    end if

    if not objFSO.FolderExists(targetFolder) then
        msgBox("Kan ikke åbne destination : "&targetFolder)
        chk=false
    end if
end function

sub Quit()
    MsgBox "Forbindelsen til netværket afbrudt"
    WScript.Quit
end sub

sub doCopy(sourceFolder,targetFolder)
    dim folder,fileCol,folderCol,fil,tFolder,tFileCol,tFolderCol,FileStr,FolderStr
    Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

    set folder = objFSO.getFolder(sourceFolder)
    set tFolder = objFSO.getFolder(targetFolder)

    set tFolderCol=tFolder.SubFolders
    set tFileCol=tFolder.Files

    set fileCol = folder.Files
    set folderCol=folder.SubFolders
   
    FileStr=""
    For Each fil in tFileCol
        FileStr=FileStr&";"&fil.name&";,"
    next
    FolderStr=""
    For Each folder in tFolderCol
        FolderStr=FolderStr&";"&folder.name&";,"
    next
    For Each fil in filecol
        if not objFSO.FileExists(targetFolder&"\"&fil.name) then
            objFSO.CopyFile SourceFolder&"\"&fil.name, targetFolder&"\"&fil.name
           
            If Err.Number = 0 Then
                log "Copying file: "&sourceFolder&"\"&fil.name
            else
              Quit()
            end if
        end if
        FileStr=Replace(FileStr,";"&fil.name&";,","")
    next   

    For Each folder in folderCOl
        if not objFSO.FolderExists(targetFolder&"\"&folder.name) then
           
            objFSO.CreateFolder(targetFolder&"\"&folder.name)
            If Err.Number = 0 Then
                log "Creating folder: "&sourceFolder&"\"&folder.name
            else
                Quit()
            end if

        end if
        FolderStr=Replace(FolderStr,";"&folder.name&";,","")
        doCopy sourceFolder&"\"&folder.name,targetFolder&"\"&folder.name   
    next   

    set fileCol = nothing
    set folderCol = nothing
    set folder = nothing
   
    dim delArrFile,delArrFolder,a

    if len(FileStr)>0 then
        delArrFile=split(FileStr,",")
        For a = LBound(delArrFile) to UBound(delArrFile)-1
            objFSO.DeleteFile(targetFolder&"\"&replace(delArrFile(a),";",""))   
        next
    end if

    if len(FolderStr)>0 then
       
        delArrFolder=split(FolderStr,",")
        For a = LBound(delArrFolder) to UBound(delArrFolder)-1
            objFSO.DeleteFolder(targetFolder&"\"&replace(delArrFolder(a),";",""))   
        next
    end if
   
    set tFileCol = nothing
    set tFolderCol = nothing
    set tFolder = nothing   
end sub

Dim objFSO,wshShell
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

sourceFolder="C:\test"
targetFolder="C:\test1"

Set WshShell = CreateObject("WScript.Shell")
WshShell.Popup "Begynder kopiering", 2, , 0

if (chk (sourceFolder,targetFolder)) then
    doCopy sourceFolder,targetFolder
    WshShell.Popup "Kopiering afsluttet", 2, , 0
end if

Set WshShell = nothing
Set objFSO = nothing