Page 3 of 3 FirstFirst 123
Results 31 to 42 of 42
  1. #31
    June7's Avatar
    June7 is offline VIP
    Windows 10 Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,815
    Still don't show code of how imgPath and AccPath are populated.



    I don't think that FileCopy is doing what you think. Step debug and see what variables are set to and what the concatenated results are.

    If you want to rename and copy into another folder at same time:
    Code:
    Dim strOldPath As String, strNewPath As String, strNewName As String, strSourceFile As String, x As Integer
    strOldPath = "\\servername\oldpath\"
    strNewPath = "\\servername\newpath\"
    strSourceFile = Dir(strOldPath & "*.*")
    x = 1
    Do Until strSourceFile = vbNullString
        strNewName = mDealer & "-" & Format(Now(),"dd-mm-yy") & "-" & x & ".jpg"
        Name strOldPath & strSourceFile As strNewPath & strNewName
        strSourceFile = Dir
        x = x + 1
    Loop
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  2. #32
    moke123's Avatar
    moke123 is offline Me.Dirty=True
    Windows 7 32bit Access 2010 32bit
    Join Date
    Oct 2012
    Location
    Ma.
    Posts
    1,643
    Is this correct?
    You want take a folder with pictures in it and rename them using a Name and sequential numbers.
    You want to then use them as attachments in an email.
    You want to copy them to a back up folder with the new names.
    you then want to delete all the pictures in the original folder.

    if so, heres a demo that does the above.
    I broke the procedures down to a series of procedures you call from a stack
    It renames the files in the PixFolder
    Passes the files to an email procedure - I did not write a procedure for this but it shows the relevant code to iterate throught the pictures and attach them.
    Moves the renamed pictures (Instead of deleting them) to a newly created folder (using your name ie."Joe Bloggs")in the BackUpFolder

    I included some pictures for testing purposes.
    Attached Files Attached Files

  3. #33
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185
    Hi June7 and Moke123, thank you for response, i will try today and see where i get, failing that, i will put the full procedure on

    Kindest

  4. #34
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185
    Hi have tried this and get the FIle Not Found message! can you corret where i am going wrong ??

    I have added a folder called Images in and a srcPath, this is the SD card slot where DSC00001 and DSC00002 images are

    My idea of this is to save them initially from the SD card and call them DMT-1 and DMT-2

    Click image for larger version. 

Name:	Capture.JPG 
Views:	22 
Size:	24.3 KB 
ID:	39799

  5. #35
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185
    Hi June7, i think i am getting lost with myself here, i have copied the full code here and commented out some of it just as a quick fix so that filedialog will open the Camera SD path and the new dealer folder

    I think i need to try and do the following for easiness if i can

    1: put the sd card in the pc from camera (drive F: etc..)

    2: loop through the files on Drive F: etc.. and rename the files on the SD card

    3: copy them to the dealer folder

    4: Kill the files on the SD card

    I know you great paople can shorten what i have done here and make it work better ?

    Code:
    SrcPath = "F:\DCIM\101MSDCF\"
    'srcFiles = Dir(SrcPath & "*.*")
    'DestImg = "T:\Images\Images In\"
    'sf = 1
    'Do Until srcFiles = vbNullString
    'srcNewName = "DMT" & "-" & sf& ".jpg"
    'Name SrcPath & srcFiles As DestImg & srcNewName
    'srcFiles = Dir
    'sf = sf + 1
    'Loop
     
    imgDealer = InputBox("Enter Abbreviated Dealer Name?", "ENTER ABBR DEALER")
    Set rs = CurrentDb.OpenRecordset("Select * FromtblDealers WHERE Name Like ""*" & imgDealer & "*""ORDER BY Name;")
    Do Until rs.EOF
    mBody = mBody & Chr(149) & " " &rs.Fields("RecordNo") & Chr(149) & "  " &rs.Fields("Name") & "  " &rs.Fields("Town") & vbNewLine
    rs.MoveNext
    Loop
    RecNo = InputBox("Enter Number Of Which Dealer ToSearch ?" & Chr(10) & Chr(10) & _
    mBody, "WHICH DEALER")
    mDealer = DLookup("Name", "tblDealers","[RecordNo] = " & RecNo)
    MyInput = InputBox("Enter The Location For Your NewImages ?" & Chr(10) & Chr(10) & _
    ">> 1 << Deliveries" & Chr(10)& Chr(10) & _
    ">> 2 << Collections" & Chr(10)& Chr(10) & _
    ">> 3 << Returns", "ENTER IMAGELOCATION")
    Select Case MyInput
    Case 1
    Dest = "Deliveries"
    Case 2
    Dest = "Collections"
    AccImgPath = "T:\CUSTOMER NAME\DMT Images\" &Dest & "\" & mDealer
    Case 3
    Dest = "Returns"
    AccImgPath = "T:\CUSTOMER NAME\DMT Images\" &Dest & "\" & mDealer
    End Select
     
    imgPath = "T:\Images\" & Dest &"\" & mDealer & "\"
     
    If Dir(imgPath, vbDirectory) = "" Then
    MkDir (imgPath)
    Else
    DoCmd.CancelEvent
    End If
     
    If Dir(AccImgPath, vbDirectory) = "" Then
    MkDir (AccImgPath)
    Else
    DoCmd.CancelEvent
    End If
     
     
     
    Set fds = Application.FileDialog(msoFileDialogFilePicker)
    fds.InitialFileName = SrcPath
    With fds
    .Title = "CLICK ORGANIZE / SELECT ALL / ORGANIZE /CUT"
    .InitialFileName = SrcPath
    If .Show = -1 Then
    .Show
    DoCmd.RunCommand acCmdAppMinimize
    End If
    End With
     
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.InitialFileName = imgPath
    With fd
    .Title = "CLICK ORGANIZE / PASTE"
    .InitialFileName = imgPath
    If .Show = -1 Then
    .Show
    DoCmd.RunCommand acCmdAppMinimize
    End If
    End With
     
    Set fso =CreateObject("Scripting.FileSystemObject")
    Set ObjFiles = fso.getfolder(imgPath).Files
    imgQty = ObjFiles.Count
    If MsgBox("File Quantity Confirmed = " &imgQty & vbNewLine & vbNewLine & _
    "Rename Files Now ?", vbQuestion + vbYesNo,"FILE COUNT") = vbNo Then
    DoCmd.CancelEvent
    Else
    strPath = imgPath
    strFile = Dir(strPath & "*.*")
    x = 1
    Do Until strFile = vbNullString
    NewName = mDealer & "-" & Format(Now(),"dd-mm-yy") & "-" & x & ".jpg"
    Name strPath & strFile As strPath & NewName
    strFile = Dir
    x = x + 1
    Loop
    End If

  6. #36
    moke123's Avatar
    moke123 is offline Me.Dirty=True
    Windows 7 32bit Access 2010 32bit
    Join Date
    Oct 2012
    Location
    Ma.
    Posts
    1,643
    You can shorten your code a little bit by removing all the "DoCmd.CancelEvent" entries. Cancel event only applies to events that have a cancel arguement such as the before update event.

    Do yourself a favor and google "smart indenter" its a free add on that will format your code so its more readable.
    You may need the wayback machine to find it...http://web.archive.org/web/201801301...er/Default.htm as it looks like their site is down.

    Code:
        SrcPath = "F:\DCIM\101MSDCF\"
        'srcFiles = Dir(SrcPath & "*.*")
        'DestImg = "T:\Images\Images In\"
        'sf = 1
        'Do Until srcFiles = vbNullString
        'srcNewName = "DMT" & "-" & sf& ".jpg"
        'Name SrcPath & srcFiles As DestImg & srcNewName
        'srcFiles = Dir
        'sf = sf + 1
        'Loop
    
    
        imgDealer = InputBox("Enter Abbreviated Dealer Name?", "ENTER ABBR DEALER")
        Set rs = CurrentDb.OpenRecordset("Select * FromtblDealers WHERE Name Like ""*" & imgDealer & "*""ORDER BY Name;")
        Do Until rs.EOF
            mBody = mBody & Chr(149) & " " & rs.Fields("RecordNo") & Chr(149) & "  " & rs.Fields("Name") & "  " & rs.Fields("Town") & vbNewLine
            rs.MoveNext
        Loop
        RecNo = InputBox("Enter Number Of Which Dealer ToSearch ?" & Chr(10) & Chr(10) & _
                         mBody, "WHICH DEALER")
        mDealer = DLookup("Name", "tblDealers", "[RecordNo] = " & RecNo)
        MyInput = InputBox("Enter The Location For Your NewImages ?" & Chr(10) & Chr(10) & _
                           ">> 1 << Deliveries" & Chr(10) & Chr(10) & _
                           ">> 2 << Collections" & Chr(10) & Chr(10) & _
                           ">> 3 << Returns", "ENTER IMAGELOCATION")
        Select Case MyInput
        Case 1
            Dest = "Deliveries"
        Case 2
            Dest = "Collections"
            AccImgPath = "T:\CUSTOMER NAME\DMT Images\" & Dest & "\" & mDealer
        Case 3
            Dest = "Returns"
            AccImgPath = "T:\CUSTOMER NAME\DMT Images\" & Dest & "\" & mDealer
        End Select
    
    
        imgPath = "T:\Images\" & Dest & "\" & mDealer & "\"
    
    
        If Dir(imgPath, vbDirectory) = "" Then
            MkDir (imgPath)
        Else
            DoCmd.CancelEvent
        End If
    
    
        If Dir(AccImgPath, vbDirectory) = "" Then
            MkDir (AccImgPath)
        Else
            DoCmd.CancelEvent
        End If
    
    
    
    
    
    
        Set fds = Application.FileDialog(msoFileDialogFilePicker)
        fds.InitialFileName = SrcPath
        With fds
            .Title = "CLICK ORGANIZE / SELECT ALL / ORGANIZE /CUT"
            .InitialFileName = SrcPath
            If .Show = -1 Then
                .Show
                DoCmd.RunCommand acCmdAppMinimize
            End If
        End With
    
    
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        fd.InitialFileName = imgPath
        With fd
            .Title = "CLICK ORGANIZE / PASTE"
            .InitialFileName = imgPath
            If .Show = -1 Then
                .Show
                DoCmd.RunCommand acCmdAppMinimize
            End If
        End With
    
    
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set ObjFiles = fso.GetFolder(imgPath).Files
        imgQty = ObjFiles.Count
        If MsgBox("File Quantity Confirmed = " & imgQty & vbNewLine & vbNewLine & _
                  "Rename Files Now ?", vbQuestion + vbYesNo, "FILE COUNT") = vbNo Then
            DoCmd.CancelEvent
        Else
            strPath = imgPath
            strFile = Dir(strPath & "*.*")
            x = 1
            Do Until strFile = vbNullString
                NewName = mDealer & "-" & Format(Now(), "dd-mm-yy") & "-" & x & ".jpg"
                Name strPath & strFile As strPath & NewName
                strFile = Dir
                x = x + 1
            Loop
        End If

  7. #37
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185
    Hi Moke123, thank you so much, i will try what you have suggested a touch later but thank you for your response

  8. #38
    moke123's Avatar
    moke123 is offline Me.Dirty=True
    Windows 7 32bit Access 2010 32bit
    Join Date
    Oct 2012
    Location
    Ma.
    Posts
    1,643
    Dave,
    If you notice, in the demo I posted I broke down the various procedures into several separate procedures.
    By doing this it is much easier to get each piece working right and then you bring it all together by stacking them together in a master procedure.

    Code:
    Sub ProcessAttachments(strText As String)
    
    
        Dim SourceFolder As String
        Dim NewNames As String
        Dim BUFolder As String
    
    
        SourceFolder = CurrentProject.Path & "\PixFolder"    'hard coded locations
        BUFolder = CurrentProject.Path & "\BackUpFolder"
    
    
        'Rename the files in folder
        RenameFiles SourceFolder, strText
    
    
        'get the new names of the files
        NewNames = fGetFileNames(SourceFolder & "\")
    
    
        'Attach to email
        sEMailProcedure NewNames, SourceFolder
    
    
        'Move to back up folder
        Move_Files SourceFolder, BUFolder & "\" & strText & Format(Date, "_mm_dd_yy")
    
    
    End Sub
    You have these 2 pieces of code in your posted procedure
    Code:
      Set fds = Application.FileDialog(msoFileDialogFilePicker)    
        fds.InitialFileName = SrcPath
        With fds
            .Title = "CLICK ORGANIZE / SELECT ALL / ORGANIZE /CUT"
            .InitialFileName = SrcPath
            If .Show = -1 Then
                .Show
                DoCmd.RunCommand acCmdAppMinimize
            End If
        End With
    
    
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        fd.InitialFileName = imgPath
        With fd
            .Title = "CLICK ORGANIZE / PASTE"
            .InitialFileName = imgPath
            If .Show = -1 Then
                .Show
                DoCmd.RunCommand acCmdAppMinimize
            End If     End With
    Not really sure what your doing this for as all its doing is minimizing the app window.
    generally such code is in a public function and returns a value such as the selected file of folder.

    for example this will return a folder path. If you want to set options such as initial folders you would add those as arguments - Public Function GetFolderPath(initDir as string) as String.
    Code:
    Public Function GetFolderPath() As String
    
          With Application.FileDialog(msoFileDialogFolderPicker)
            ' show the file picker dialog box
            If .Show <> 0 Then
                
                GetFolderPath = .SelectedItems(1)
    
            End If
        End With
    
    End Function
    HTH

  9. #39
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185
    Hi Guy's thank you so much for your help, all works with your suggestion, what is easiest method to move files into a backup folder and keep the file names the same and overwrite if they already exist in the backup folder, also count the files before and after in both folders so:

    If we have 26 files to back up strFromPath and 204 files in strToPath
    Do the file transfer then 0 files in strFromPath and 230 files in strToPath

    Based on post 31, do I need x = 1 ?

    and would I need x = x + 1 before loop ?

    These are jpg files

    Thank you

  10. #40
    moke123's Avatar
    moke123 is offline Me.Dirty=True
    Windows 7 32bit Access 2010 32bit
    Join Date
    Oct 2012
    Location
    Ma.
    Posts
    1,643
    what is easiest method to move files into a backup folder and keep the file names the same and overwrite if they already exist in the backup folder, also count the files before and after in both folders so:
    The CopyFile method (in demo) has an argument for overwrite. I'm not sure if the MoveFile method (also in demo) has that arguement.

    for file counts in a directory...
    Code:
    Public Function fGetFileCount(strFolderName As String) As Variant
    
        Dim fso As Object
        Dim objFiles As Object
            
       Set fso = CreateObject("Scripting.FileSystemObject")
       
        Set objFiles = fso.GetFolder(strFolderName).Files
        
        fGetFileCount = objFiles.Count     'Assign the file count to the function
        
        Set fso = Nothing
        Set objFiles = Nothing
        
    End Function

  11. #41
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185
    Hi Guy's I thought I had this one, I have been playing around with code for backing up 3 folders aPath is always "from folder" and bPath is always to folder, it's coming up debug object variable or With block variable not set run time error 91

    The reason I have played about with it is that if there are no files to backup, then it needs to abort Name As option, I think I just have a sequence wrong somewhere, the debug is aFiles = Dir(aPath & "*.*")

    Can this code be corrected please ?

    Code:
    Dim aPath As String, bPath As String
    Dim aCount As Integer, bCount As Integer, MyInput As Integer
    Dim aFSO As Object, bFSO As Object
    Dim aFiles As Object, bFiles As Object
     
    If Me.cboFolderActions = "Backup PO's" Then
    MyInput = InputBox("Select Which Folder To Backup?" & vbNewLine & _
    " > 1 < = In Stock" & vbNewLine & _
    " > 2 < = Due In" & vbNewLine & _
    " > 3 < = On Hold", "WHICHFOLDER")
    Select Case MyInput
    Case 1
    aPath = "T:\Local\HG PO's\In Stock\"
    bPath = "T:\Customer\Customer Backup\HG's\InStock\"
    aFiles = Dir(aPath & "*.*")
    Set aFSO =CreateObject("Scripting.FileSystemObject")
    Set bFSO = CreateObject("Scripting.FileSystemObject")
    Set aFiles = aFSO.getfolder(aPath).Files
    Set bFiles = bFSO.getfolder(bPath).Files
    aCount = aFiles.Count
    bCount = bFiles.Count
    If MsgBox("In Folder:" & vbNewLine & _
    aPath & "(HG STOCK)" & vbNewLine & _
    "There Are: " & aCount & " "& "PO's To Back Up" & vbNewLine & vbNewLine & _
    "In Backup Folder:" & vbNewLine & _
    bPath & "(CUSTOMER BACKUP)" & vbNewLine& _
    "There Are: " & bCount & " "& "PO's Already Backed Up", vbInformation + vbOKOnly, "FILESCONFIRMED") = vbOK Then
    If aFiles = vbNullString Then
    MsgBox ("Aborting Backup as there is no files tobackup!"), vbInformation + vbOKOnly, "NO FILES TO BACKUP"
    DoCmd.CancelEvent
    Else
    Do Until aFiles = vbNullString
    Name aPath & aFiles As bPath & aFiles
    aFiles = Dir
    Loop
    End If
    End If
    Set aFSO = Nothing
    Set bFSO = Nothing
    Set aFiles = Nothing
    Set bFiles = Nothing
     
    Case 2
    aPath = "T:\Local\HG PO's\Due In\"
    bPath = "T:\Customer\Customer Backup\HG's\DueIn\"
    aFiles = Dir(aPath & "*.*")
    Set aFSO = CreateObject("Scripting.FileSystemObject")
    Set bFSO =CreateObject("Scripting.FileSystemObject")
    Set aFiles = aFSO.getfolder(aPath).Files
    Set bFiles = bFSO.getfolder(bPath).Files
    aCount = aFiles.Count
    bCount = bFiles.Count
    If MsgBox("In Folder:" & vbNewLine & _
    aPath & "(DUE IN)" & vbNewLine & _
    "There Are: " & aCount & " "& "PO's To Back Up" & vbNewLine & vbNewLine & _
    "In Backup Folder:" & vbNewLine & _
    bPath & "(CUSTOMER BACKUP)" & vbNewLine& _
    "There Are: " & bCount & " "& "PO's Already Backed Up", vbInformation + vbOKOnly, "FILESCONFIRMED") = vbOK Then
    If aFiles = vbNullString Then
    MsgBox ("Aborting Backup as there is no files tobackup!"), vbInformation + vbOKOnly, "NO FILES TO BACKUP"
    DoCmd.CancelEvent
    Else
    Do Until aFiles = vbNullString
    Name aPath & aFiles As bPath & aFiles
    aFiles = Dir
    Loop
    End If
    End If
    Set aFSO = Nothing
    Set bFSO = Nothing
    Set aFiles = Nothing
    Set bFiles = Nothing
    Case 3
    aPath = "T:\Local\HG PO's\On Hold\"
    bPath = "T:\Customer\Customer Backup\HG's\OnHold\"
    aFiles = Dir(aPath & "*.*")
    Set aFSO =CreateObject("Scripting.FileSystemObject")
    Set bFSO =CreateObject("Scripting.FileSystemObject")
    Set aFiles = aFSO.getfolder(ePath).Files
    Set bFiles = bFSO.getfolder(fPath).Files
    aCount = aFiles.Count
    bCount = bFiles.Count
    If MsgBox("In Folder:" & vbNewLine & _
    aPath & "(ON HOLD)" & vbNewLine & _
    "There Are: " & aCount & " "& "PO's To Back Up" & vbNewLine & vbNewLine & _
    "In Backup Folder:" & vbNewLine & _
    bPath & "(CUSTOMER BACKUP)" & vbNewLine& _
    "There Are: " & bCount & " "& "PO's Already Backed Up", vbInformation + vbOKOnly, "FILESCONFIRMED") = vbOK Then
    If aFiles = vbNullString Then
    MsgBox ("Aborting Backup as there is no files tobackup!"), vbInformation + vbOKOnly, "NO FILES TO BACKUP"
    DoCmd.CancelEvent
    Else
    Do Until aFiles = vbNullString
    Name aPath & aFiles As bPath & aFiles
    aFiles = Dir
    Loop
    End If
    End If
    Set aFSO = Nothing
    Set bFSO = Nothing
    Set aFiles = Nothing
    Set bFiles = Nothing
    End Select
    End If

  12. #42
    moke123's Avatar
    moke123 is offline Me.Dirty=True
    Windows 7 32bit Access 2010 32bit
    Join Date
    Oct 2012
    Location
    Ma.
    Posts
    1,643
    you need a space between vbNewLine and the & in all 3 cases


    Code:
    If MsgBox("In Folder:" & vbNewLine & _
    aPath & "(HG STOCK)" & vbNewLine & _
    "There Are: " & aCount & " "& "PO's To Back Up" & vbNewLine & vbNewLine & _
    "In Backup Folder:" & vbNewLine & _
    bPath & "(CUSTOMER BACKUP)" & vbNewLine& _
    "There Are: " & bCount & " "& "PO's Already Backed Up", vbInformation + vbOKOnly, "FILESCONFIRMED") = vbOK Then
    edit: I would be careful using special characters in directory names

Page 3 of 3 FirstFirst 123
Please reply to this thread with any new information or opinions.

Similar Threads

  1. Renaming a Module
    By George in forum Modules
    Replies: 4
    Last Post: 09-04-2017, 06:43 AM
  2. Renaming values?
    By brownk in forum Queries
    Replies: 6
    Last Post: 06-25-2012, 12:56 PM
  3. Renaming Utility
    By bginhb in forum Access
    Replies: 3
    Last Post: 11-02-2011, 03:11 PM
  4. Renaming a file using VBA
    By bfaucher in forum Programming
    Replies: 1
    Last Post: 11-01-2011, 02:56 PM
  5. Renaming fields
    By WilsonsW in forum Access
    Replies: 10
    Last Post: 03-25-2011, 01:20 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums