UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Moving File From One Folder To Another?, Access 2016    
 
   
ciapul12
post Jun 19 2019, 09:39 AM
Post#1



Posts: 285
Joined: 7-June 14



Hi There,
Is it possible to program access button to find latest JPEG in the folder and move it to another location?
If so, does anyone have a code please?

Thanks in advance.
Dan
Go to the top of the page
 
theDBguy
post Jun 19 2019, 09:50 AM
Post#2


Access Wiki and Forums Moderator
Posts: 76,073
Joined: 19-June 07
From: SunnySandyEggo


Hi Dan. What constitutes "latest" in the files? Last modified or filename? etc.

--------------------
Just my 2 cents... "And if I claim to be a wise man, it surely means that I don't know" - Kansas
Access Website | Access Blog | Email
Go to the top of the page
 
DanielPineault
post Jun 19 2019, 10:45 AM
Post#3


UtterAccess VIP
Posts: 6,774
Joined: 30-June 11



See http://spreadsheetpage.com/index.php/tip/i...in_a_directory/ for a great starting point.

--------------------
Daniel Pineault (2010-2019 Microsoft MVP)
Professional Help: http://www.cardaconsultants.com
Free MS Access Code, Tips, Tricks and Samples: http://www.devhut.net

* Design should never say "Look at me". It should always say "Look at this". -- David Craib
* A user interface is like a joke, if you have to explain it, it's not that good! -- Martin LeBlanc


All code samples, demonstration databases, links,... are provided 'AS IS' and are to be used at your own risk! Take the necessary steps to check, validate ...(you are responsible for your choices and actions)
Go to the top of the page
 
ciapul12
post Jun 21 2019, 05:06 AM
Post#4



Posts: 285
Joined: 7-June 14



Hi theDBguy!
Last Modified date including time...
Dan
Go to the top of the page
 
WildBird
post Jun 23 2019, 10:28 PM
Post#5


UtterAccess VIP
Posts: 3,594
Joined: 19-August 03
From: Auckland, Little Australia


This is Excel code, but easily converted to Access. This will get the latest file in a folder, you specify the path, search string and extension.

Once you have this latest file, you can write a simple one line to move the file to where ever you want.

CODE
Function GetLatestFileName(ByVal strFolderName As String, ByVal strSearchString As String, ByVal strExtension As String) As String
'Date:          Wednesday, 10 April 2019 8:12:51 AM
'Author:        Stephen Cooper
'Email:         coopers@XXXXXXXXXX.com
'Ph:
'In parameters
'Output
'Description:   Will return the latest filename from a directory, matching a string
'Calls:
'Notes:
'Example:

On Error GoTo HandleError:

Dim intMouseType As Integer
Dim strErrorMsg As String
Dim varReturn As Variant
Dim dBaseDate As Date
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim dMaxDate As Date
Dim strFileName As String
Dim strTempFileName As String

intMouseType = Application.Cursor

Application.Cursor = xlWait

dBaseDate = #9/24/1966#

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(strFolderName)

For Each objFile In objFolder.Files
    strFileName = objFile.Name
    If Left(strFileName, 1) <> "~" Then
        If Right(strFileName, Len(strExtension)) = strExtension Then
            If InStr(1, strFileName, strSearchString) > 1 Then
                If objFile.DateLastModified > dBaseDate Then
                    dMaxDate = objFile.DateLastModified
                    strTempFileName = strFileName
                End If 'objFile.ModifiedDate > dBaseDate
            End If 'InStr(1, strFileName, strSearchString) > 1
        End If 'Right(strFileName, Len(strExtension)) = strExtension
    End If 'Left(stfrilename, 1) <> "~"
Next objFile

'Now see if there is any file
If Len(strTempFileName) > 0 Then
    GetLatestFileName = strTempFileName
End If 'Len(strTempFileName) > 0

ExitHere:
On Error Resume Next
'Close all recordsets etc here
Application.Cursor = intMouseType
Exit Function

HandleError:
Select Case Err.Number
Case Else
    'LogError "GetLatestFileName|" & CurrentProject.Name & "|" & strErrorMsg & "|" & Err.Number & " - " & Err.Description & "| Line number " & Erl
    MsgBox strErrorMsg & " " & Err.Number & " " & Err.Description, vbInformation, "Error"
    GetLatestFileName = False
    'DoCmd.Close acForm, strUpdateForm, acSaveNo
    Resume ExitHere
End Select

End Function

--------------------
Beer, natures brain defragging tool.
Go to the top of the page
 
ciapul12
post Jul 4 2019, 10:55 AM
Post#6



Posts: 285
Joined: 7-June 14



Which part needs changing? don't really get it... Where is the folder patch defined?

Thanks
Dan
Go to the top of the page
 
ADezii
post Jul 4 2019, 01:25 PM
Post#7



Posts: 2,553
Joined: 4-February 07
From: USA, Florida, Delray Beach


  1. For the sake of brevity and simplicity I changed the Code to work in Access. I also used Late Binding and kept all of the Code in-line.
  2. I stuck with using the Microsoft Scripting Runtime from the original Code.
  3. It should do exactly as you request, namely: Copy the *.jpg File in a designated Folder with the Latest Modified Date to another Folder, then DELETE the Original File (actually a Move operation).
  4. I created a USER DEFINED SECTION for you and all you need to do is to change these Values to those of your own choosing.
  5. Code Definition:
    CODE
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim dteMaxDate As Date
    Dim strFileName As String
    Dim strTempFile As String
    Dim dteBaseDate As Date

    dteBaseDate = #1/1/1980#

    '********* USER DEFINED SECTION *********
    Const conFOLDER = "C:\Pics"
    Const conEXTENSION = ".jpg"
    Const conDEST_FLD = "C:\Temp"
    '****************************************

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set objFolder = objFSO.GetFolder(conFOLDER)

    For Each objFile In objFolder.Files
      strFileName = objFile.Name
        If Right(strFileName, Len(conEXTENSION)) = conEXTENSION Then
          If objFile.DateLastModified > dteBaseDate Then
            dteMaxDate = objFile.DateLastModified       'New MAX Date, for Reference only
            dteBaseDate = objFile.DateLastModified      'New Base Date
            strTempFile = strFileName
          End If
        End If
    Next objFile

    If Len(strTempFile) > 0 Then
      FileCopy conFOLDER & "\" & strTempFile, conDEST_FLD & "\" & strTempFile      'Copy the Latest File
      Kill conFOLDER & "\" & strTempFile        'DELETE Latest File
      MsgBox strTempFile & " | " & dteMaxDate
    End If
  6. Good Luck with your Project.

Go to the top of the page
 
ciapul12
post Jul 5 2019, 07:04 AM
Post#8



Posts: 285
Joined: 7-June 14



Woooooooooooooooooooooow! This is exactly what I needed :-) Thank You!

Can you please help me with one more think? My folder path where images are being moved from is as follow: \\dpl\lfs\users\dress\Pictures\Camera Roll, dress is the name of my user profile but I can't have this hard coded as this system is used by multiple users so what changes do I need to make in order to accommodate multi users?
I've tried: \\dpl\lfs\users\Pictures\Camera Roll and \\dpl\lfs\users\user\Pictures\Camera Roll but neither work

Dan
Go to the top of the page
 
ADezii
post Jul 5 2019, 07:16 AM
Post#9



Posts: 2,553
Joined: 4-February 07
From: USA, Florida, Delray Beach


How are you retrieving the User Name?
Go to the top of the page
 
ciapul12
post Jul 5 2019, 08:47 AM
Post#10



Posts: 285
Joined: 7-June 14



In what sense?
Go to the top of the page
 
ADezii
post Jul 5 2019, 09:01 AM
Post#11



Posts: 2,553
Joined: 4-February 07
From: USA, Florida, Delray Beach


In the UNC Path
CODE
\\dpl\lfs\users\dress\Pictures\Camera Roll

dress is being replaced with the actual User Name, how are you obtaining this? It is actually irrelevant how this String is obtained. The fact of the matter is that dress needs to be replaced by the User Name/Profile within the UNC Path.
  1. Let's assume that the User Name is FrankNStein, the From UNC Path needs to be changed from
    CODE
    \\dpl\lfs\users\dress\Pictures\Camera Roll
  2. to
    CODE
    \\dpl\lfs\users\FrankNStein\Pictures\Camera Roll
  3. Once the User's Name is retrieved, this is accomplished by a simple Replace() with the Base Path String.
  4. The FileCopy() and Kill operations also need to be updated with the New Path.
  5. Should the Path not exist or is not accessible, the Error Trap will catch it and inform the User.
  6. Cleanup chores also need to be done at the end of the Code Segment.
  7. I'll stop rambling on now and post the Revised Code. It is AIR CODE and has NOT been tested on a UNC Path.
  8. Revised Code:
    CODE
    Private Sub cmdTest_Click()
    On Error GoTo Err_cmdTest_Click
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim dteMaxDate As Date
    Dim strFileName As String
    Dim strTempFile As String
    Dim dteBaseDate As Date
    Dim strUser As String
    Dim strNewFldr As String

    dteBaseDate = #1/1/1980#

    '******************** USER DEFINED SECTION ********************
    Const conFOLDER = "\\dpl\lfs\users\dress\Pictures\Camera Roll"
    Const conEXTENSION = ".jpg"
    Const conDEST_FLD = "C:\Temp"
    '**************************************************************

    strUser = "FrankNStein"     'replace with mechanism to retrieve Name
    strNewFldr = Replace(conFOLDER, "dress", strUser)   'Replace 'dress' with User

    'Does the Folder even exist, Error Trap will catch this if so (Error 52)

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set objFolder = objFSO.GetFolder(strNewFldr)

    For Each objFile In objFolder.Files
      strFileName = objFile.Name
        If Right(strFileName, Len(conEXTENSION)) = conEXTENSION Then
          If objFile.DateLastModified > dteBaseDate Then
            dteMaxDate = objFile.DateLastModified       'New MAX Date, just a Visual cue
            dteBaseDate = objFile.DateLastModified      'New Base Date
            strTempFile = strFileName
          End If
        End If
    Next objFile

    If Len(strTempFile) > 0 Then
      FileCopy strNewFldr & "\" & strTempFile, conDEST_FLD & "\" & strTempFile      'Copy the Latest File
      Kill strNewFldr & "\" & strTempFile        'DELETE Latest File
    End If

    Set objFSO = Nothing
    Set objFolder = Nothing
    Set objFile = Nothing

    Exit_cmdTest_Click:
      Exit Sub

    Err_cmdTest_Click:
      If Err.Number = 52 Then
        MsgBox "The Folder [" & strNewFldr & "] does not exist or cannot be accessed!", _
                vbExclamation, "Folder Error"
      Else
        MsgBox Err.Description & Err.Number, vbExclamation, "Error in cmdTest_Click()"
      End If
        Resume Exit_cmdTest_Click
    End Sub

This post has been edited by ADezii: Jul 5 2019, 09:36 AM
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    23rd August 2019 - 08:17 AM