Page 1 of 2 12 LastLast
Results 1 to 15 of 17
  1. #1
    3 Star Lounger
    Join Date
    Jul 2008
    Location
    Suffolk, United Kingdom
    Posts
    308
    Thanks
    0
    Thanked 0 Times in 0 Posts

    HELP, file copy problems (2003)

    Hi,

    Below is some code I edited roughly and quickly from Hans. I changed the code to move files in one directory into another, because IT changed are file stucture. However they have sorted incorrectly (I have a backup source)

    Original locations were filed 'CRN Comm 0' through to 'CRN Comm 9'
    The new location is further broken down by the first 2 digits of the filename instead of 1 digit. example 123454.doc is filed in subdirectory 12123454.doc

    Unfortunatly my code is droping all the files into 1 folder.

    If possible can the code also verify only 6 numbers are used in the file name and extension .doc so it ignores for example. 123423a.doc

    Many thanks


    Private Sub CommandButton1_Click()
    Dim strSource As String
    Dim strTarget As String
    Dim strSubFolder As String
    Dim strDocName As String
    Dim doc As Document
    ' Dim strDigit As String

    'strDigit = InputBox("What filing system are you using? Enter 1 or 2 digit", "Information request")


    On Error GoTo ErrHandler
    ' Hide what's going on
    Application.ScreenUpdating = False
    ' Get paths to source and target folder
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the source folder (the single digit folder)"
    If .Show = True Then
    strSource = .SelectedItems(1)
    If Not Right(strSource, 1) = "" Then
    strSource = strSource & ""
    End If
    Else
    Exit Sub
    End If
    .Title = "Select the root specialty folder"
    If .Show = True Then
    strTarget = .SelectedItems(1) & ""
    strDocName = Dir(strSource & "*.doc")
    strSubFolder = Left(strDocName, 2)
    If Not Right(strTarget, 1) = "" Then
    strTarget = strTarget & "" & strSubFolder
    End If
    Else
    Exit Sub
    End If
    'If strTarget = strSource Then
    ' MsgBox "The target folder cannot be the same as the source folder!", _
    ' vbExclamation
    'Exit Sub
    'End If
    End With
    ' Loop through source folder

    Do While Not strDocName = ""


    'If strDigit = "1" Then

    'Else
    'If strDigit = "2" Then
    'strSubFolder = Left(strDocName, strDigit) & ""
    'Else
    'End If
    'End If


    ' Try to open matching target doc
    On Error Resume Next
    Set doc = Documents.Open(FileName:=strTarget & strSubFolder & "" & strDocName, _
    AddToRecentFiles:=False)
    On Error GoTo ErrHandler
    If doc Is Nothing Then
    ' No match - copy
    FileCopy strSource & strDocName, strTarget & strSubFolder & "" & strDocName
    Else
    ' Go to end and insert paragraph mark
    Selection.EndKey Unit:=wdStory
    Selection.InsertBreak Type:=wdPageBreak
    Selection.EndKey Unit:=wdStory
    ' Insert source document
    Selection.InsertFile FileName:=strSource & strDocName
    ' Close and save target document
    doc.Close SaveChanges:=True
    Set doc = Nothing
    End If
    Kill strSource & strDocName
    ' On to the next one
    strDocName = Dir
    Loop

    ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

    ErrHandler:
    MsgBox Err.Description, vbExclamation
    On Error Resume Next
    If Not doc Is Nothing Then
    doc.Close SaveChanges:=False
    End If
    Resume ExitHandler
    End Sub
    Regards
    Gerbil (AKA Kevin)

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: HELP, file copy problems (2003)

    You have commented out the code that determines the subfolder to be used. See the code attached to <post:=722,981>post 722,981</post:>.

  3. #3
    3 Star Lounger
    Join Date
    Jul 2008
    Location
    Suffolk, United Kingdom
    Posts
    308
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: HELP, file copy problems (2003)

    Thanks Hans, got it going, this old fileing structure is very bad, we have had to split the files by 2 digit number because the folders where getting so big the slower machines could not access them very quickly.

    If you don't mind I would like to run a step by step process of the end result I am trying to achieve. I know you have already answered some of it and thank you but I really could use your help. (Still can't believe how much you know!)

    Thats say I have 3 secretaries in one department, called 'SEC A', 'SEC B' & 'SEC C'

    1) Point the script at the individual folders of each secretary. (There could be more than three, so some kind of add another secretary function would be good)

    2) Move to a single 'unknown' directory all files that do not have a 6 digit (numeric) file name and .doc extension. (User running script to specify unknown folder)
    Not sure how to handle possible duplicates of filename, maybe add a letter to the end of the file name or create a folder =Secretary and move to that folder.

    3) Select a 'Intermediate target' directory

    4) Move the now 6 digit .doc files from 'SEC A' into the 'INTERMEDIATE TARGET' directory

    5) Check 'SEC B' and 'SEC C' against 'INTERMEDIATE TARGET' directory for exact duplicates by filename, size and date

    6) Kill exact duplicates

    7) Append duplicates that only match by filename.doc to the matching .doc in 'INTERMEDIATE TARGET'

    8) CONFIRM COMPLETION AND MOVE TO NEXT TASK

    9) Select 'DESTINATION' ROOT Directory

    10) Move files from 'INTERMEDIATE TARGET' directory to subdirectory in 'DESTINATION ROOT' by first 2 digits of file name so that all files beginning 01 will go to the letters'selected directory'01 and the 02 to 02 etc etc.

    11) KILL FILES IN 'INTERMEDIATE TARGET'
    12) Message box 'DONE'

    We were having a problem with our slow machines getting a memory leak, I added the line 'Set doc = Nothing' which helped a lot but any other suggestions are gratefully excepted.

    Many thanks for your work with this problem I have. Thank you...
    Regards
    Gerbil (AKA Kevin)

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: HELP, file copy problems (2003)

    Kevin,

    You're asking a bit much, in my opinion. Woody's Lounge can help you with specific questions, and - as you have found - we occasionally go above and beyond that. But Woody's Lounge is not a free software developer.

    If you want a complete application, you should hire a commercial developer to create it for you.

    If you want to develop it yourself, go ahead by all means. Feel free to ask questions about specific details, but don't expect us to write the bulk of the code for you.

  5. #5
    3 Star Lounger
    Join Date
    Jul 2008
    Location
    Suffolk, United Kingdom
    Posts
    308
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: HELP, file copy problems (2003)

    Sorry Hans, That was a bit much!!

    Heres what I have, so far, I don't know how to make unlimited directory sources so I have gone with 10 and used Dim strSource as String etc. I no the code is not finished but I am getting a error Block If without End if but I cant find it.

    Heres the code:

    Private Sub CommandButton1_Click()

    Dim strSource As String
    Dim strSource1 As String
    Dim strSource2 As String
    Dim strSource3 As String
    Dim strSource4 As String
    Dim strSource5 As String
    Dim strSource6 As String
    Dim strSource7 As String
    Dim strSource8 As String
    Dim strSource9 As String

    Dim strTarget As String
    Dim strSubFolder As String
    Dim strDocName As String
    Dim strSourceSub As String
    Dim doc As Document

    On Error GoTo ErrHandler

    ' Hide what's going on
    Application.ScreenUpdating = False

    ' Get paths to source and target folder
    If MsgBox("Add source directory?", vbYesNoCancel, "Add directory") = vbCancel Then
    On Error GoTo ExitHandler
    Else
    If vbNo Then GoTo ProcessTask
    If vbYes Then GoTo SelectSource
    End If

    SelectSource:
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the source folder (the single digit folder)"

    If .Show = True Then
    strSource = .SelectedItems(1)
    If Not Right(strSource, 1) = "" Then
    strSource = strSource & ""
    End If
    Else
    Exit Sub
    End If

    If MsgBox("Add another source directory?", vbYesNo, "User input required") = vbYes Then
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the source folder (the single digit folder)"

    If .Show = True Then
    strSource1 = .SelectedItems(1)
    If Not Right(strSource1, 1) = "" Then
    strSource1 = strSource1 & ""
    End If
    Else
    Exit Sub
    End If
    GoTo SelectTarget


    If MsgBox("Add another source directory?", vbYesNo, "User input required") = vbYes Then
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the source folder (the single digit folder)"

    If .Show = True Then
    strSource2 = .SelectedItems(1)
    If Not Right(strSource2, 1) = "" Then
    strSource2 = strSource2 & ""
    End If
    Else
    Exit Sub
    End If
    GoTo SelectTarget

    If MsgBox("Add another source directory?", vbYesNo, "User input required") = vbYes Then
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the source folder (the single digit folder)"

    If .Show = True Then
    strSource3 = .SelectedItems(1)
    If Not Right(strSource3, 1) = "" Then
    strSource3 = strSource3 & ""
    End If
    Else
    Exit Sub
    End If
    GoTo SelectTarget

    If MsgBox("Add another source directory?", vbYesNo, "User input required") = vbYes Then
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the source folder (the single digit folder)"

    If .Show = True Then
    strSource4 = .SelectedItems(1)
    If Not Right(strSource4, 1) = "" Then
    strSource4 = strSource4 & ""
    End If
    Else
    Exit Sub
    End If
    GoTo SelectTarget

    If MsgBox("Add another source directory?", vbYesNo, "User input required") = vbYes Then
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the source folder (the single digit folder)"

    If .Show = True Then
    strSource5 = .SelectedItems(1)
    If Not Right(strSource5, 1) = "" Then
    strSource5 = strSource5 & ""
    End If
    Else
    Exit Sub
    End If
    GoTo SelectTarget


    If MsgBox("Add another source directory?", vbYesNo, "User input required") = vbYes Then
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the source folder (the single digit folder)"

    If .Show = True Then
    strSource6 = .SelectedItems(1)
    If Not Right(strSource6, 1) = "" Then
    strSource6 = strSource6 & ""
    End If
    Else
    Exit Sub
    End If
    GoTo SelectTarget

    If MsgBox("Add another source directory?", vbYesNo, "User input required") = vbYes Then
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the source folder (the single digit folder)"

    If .Show = True Then
    strSource7 = .SelectedItems(1)
    If Not Right(strSource7, 1) = "" Then
    strSource7 = strSource7 & ""
    End If
    Else
    Exit Sub
    End If
    GoTo SelectTarget

    If MsgBox("Add another source directory?", vbYesNo, "User input required") = vbYes Then
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the source folder (the single digit folder)"

    If .Show = True Then
    strSource8 = .SelectedItems(1)
    If Not Right(strSource8, 1) = "" Then
    strSource8 = strSource8 & ""
    End If
    Else
    Exit Sub
    End If
    GoTo SelectTarget

    If MsgBox("Add another source directory?", vbYesNo, "User input required") = vbYes Then
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the source folder (the single digit folder)"

    If .Show = True Then
    strSource9 = .SelectedItems(1)
    If Not Right(strSource9, 1) = "" Then
    strSource9 = strSource9 & ""
    End If
    Else
    Exit Sub
    End If
    GoTo SelectTarget


    SelectTarget:
    .Title = "Select the root specialty folder"
    If .Show = True Then
    strTarget = .SelectedItems(1) & ""
    strDocName = Dir(strSource & "*.doc")
    'strSubFolder = Left(strDocName, 2)
    If Not Right(strTarget, 1) = "" Then
    strTarget = strTarget & "" & strSubFolder
    End If

    Else
    Exit Sub
    End If


    End With
    ' Loop through source folder

    Do While Not strDocName = ""
    'Do While Left(strDocName, 2) = strSubFolder
    strSubFolder = Left(strDocName, 2)
    ' Try to open matching target doc
    On Error Resume Next
    Set doc = Documents.Open(FileName:=strTarget & strSubFolder & "" & strDocName, _
    AddToRecentFiles:=False)
    On Error GoTo ErrHandler
    If doc Is Nothing Then
    ' No match - copy
    FileCopy strSource & strDocName, strTarget & strSubFolder & "" & strDocName
    Else
    ' Go to end and insert paragraph mark
    Selection.EndKey Unit:=wdStory
    Selection.InsertBreak Type:=wdPageBreak
    Selection.EndKey Unit:=wdStory
    ' Insert source document
    Selection.InsertFile FileName:=strSource & strDocName
    ' Close and save target document
    doc.Close SaveChanges:=True
    Set doc = Nothing
    End If
    Kill strSource & strDocName
    ' On to the next one
    strDocName = Dir
    Loop

    ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

    ErrHandler:
    MsgBox Err.Description, vbExclamation
    On Error Resume Next
    If Not doc Is Nothing Then
    doc.Close SaveChanges:=False
    End If
    Resume ExitHandler
    End Sub


    Thanks
    Regards
    Gerbil (AKA Kevin)

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: HELP, file copy problems (2003)

    It helps if you indent your code consistently. For example, a line With ... should have the same indentation as the corresponding End With, and the lines in between should be indented one tab more. The same goes for If ... Then and End If blocks.

    If you do this, you will see that there is no End If corresponding to the If MsgBox("Add another source directory?" ... lines.
    Neither is there an End With corresponding to the With Application.FileDialog(msoFileDialogFolderPicker) lines below those If ... lines.

  7. #7
    3 Star Lounger
    Join Date
    Jul 2008
    Location
    Suffolk, United Kingdom
    Posts
    308
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: HELP, file copy problems (2003)

    Thank you, I have got it go quite nice now. Took me a while but very much worth it.

    I have no idea how to do the exact duplicates bit, any chance you can point me in the right direction. Need to be by filename, size & date

    Many thanks
    Regards
    Gerbil (AKA Kevin)

  8. #8
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: HELP, file copy problems (2003)

    Let's say that you have two strings FileNameA and FileNameB that contain a complete path and filename. You can test as follows:

    If UCase(FileNameA) = UCase(FileNameB) And _
    FileLen(FileNameA) = FileLen(FileNameB) And _
    FileDateTime(FileNameA) = FileDateTime(FileNameB) Then
    ' Code for if files are "equal"
    MsgBox "Name, size and last modified date are the same"
    Else
    ' Code for if files are "different"
    MsgBox "Files are different"
    End If

  9. #9
    3 Star Lounger
    Join Date
    Jul 2008
    Location
    Suffolk, United Kingdom
    Posts
    308
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: HELP, file copy problems (2003)

    Hi once again thank you.

    I used the code for verifing exact duplicates but it returns 'false' for UCase. FileLen and FileDateTime are fine and return true. Could you possibly look at my code and make some suggestions I have nearly got everything I wanted it for. Many thanks

    Also any ideas on more the 6 digits, anything I try just ain't working. Thank you for your kind help.
    Regards
    Gerbil (AKA Kevin)

  10. #10
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: HELP, file copy problems (2003)

    Oops, my bad. You should compare the file names without the path, of course.

    So let's say you have two paths PathA and PathB (ending in "") and two filenames FileNameA and FileNameB.

    If UCase(FileNameA) = UCase(FileNameB) And _
    FileLen(PathA & FileNameA) = FileLen(PathB & FileNameB) And _
    FileDateTime(PathA & FileNameA) = FileDateTime(PathB & FileNameB) Then
    ' Code for if files are "equal"
    MsgBox "Name, size and last modified date are the same"
    Else
    ' Code for if files are "different"
    MsgBox "Files are different"
    End If

    To test whether FileNameA consists of 6 digits followed by .doc:

    If FileNameA Like like "[0-9][0-9][0-9][0-9][0-9][0-9].doc" Then

  11. #11
    3 Star Lounger
    Join Date
    Jul 2008
    Location
    Suffolk, United Kingdom
    Posts
    308
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: HELP, file copy problems (2003)

    Thank you. Does UCase compare the file size interms of KB, I thought it was comparing that the filename is the same.

    Sorry, I got really confused about this bit.

    Many thanks
    Regards
    Gerbil (AKA Kevin)

  12. #12
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts

    Re: HELP, file copy problems (2003)

    UCase converts the name of the file to uppercase before comparing, this is so that the two files abc.doc and ABC.doc will match on this check.

    StuartR

  13. #13
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: HELP, file copy problems (2003)

    In addition to Stuart's reply: if you click in the word UCase in the Visual Basic Editor and press F1, you'll open the VBA help file for this word.

    The size of the files is compared using FileLen (again, click in the word and press F1), and their last modified date using FileDateTime (ditto).

  14. #14
    3 Star Lounger
    Join Date
    Jul 2008
    Location
    Suffolk, United Kingdom
    Posts
    308
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: HELP, file copy problems (2003)

    Ok thats what I thought, so whats the code to then compare the file size (kb)

    Thanks
    Regards
    Gerbil (AKA Kevin)

  15. #15
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts

    Re: HELP, file copy problems (2003)

    That is amazing, Hans has actually answered this question just before you asked it!!!

    StuartR

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •