[AccessD] Moving and recording files using vba in Access 2007

Paul Hartland paul.hartland at googlemail.com
Wed Mar 18 14:10:44 CDT 2015


I would just check to see if the file already exists and rename that one,
before moving the new file

For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
       ' Move each photo to new folder one at a time
       If FSO.FileExists(ToPath) Then
          fso.MoveFile ToPath, LEFT(ToPath, (LEN(ToPath)-4)) & "_" &
Format(Now(), "ddmmyyyyhhnnss") & RIGHT(ToPath,4)

    End If
        FileInFromFolder.Move ToPath

Next FileInFromFolder

This is just aircode, but should get you started

Paul

On 18 March 2015 at 13:50, Jeff Barrows <jeff.developer at gmail.com> wrote:

> I have a situation where I need to be able to click a button in Access and
> move all of the files (all photos) from one folder to another.  Along with
> moving them, which I can do, I need to be able to rename them if there is a
> file with the same name.  I also need to be able to store path and file
> name in an SQL table.
>
> Has anyone done this before?
>
> I know that this is pretty rough, but here is my rough draft code:
>
>     Dim FromPath As String
>     Dim ToPath As String
>     Dim FileInFromFolder As Object
>     Dim FileInToFolder As Object
>
>     Dim fDialog As Office.FileDialog
>     Dim FSO As Object
>
>    ' Set up the Folder Dialog. '
>     Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
>     fDialog.InitialFileName = Application.CurrentProject.path
>     With fDialog
>
>     FromPath = "C:\Program Files\ALERT\Email Photos\"
>     ToPath = "R:\" & Me.RepairsCorporateName & "\" &
> Me.cboStoreNumber.Column(2) & "\" & Me.JobNumber & "\JobPhotos\"
>
>    'Check to see if the JobPhotos folder exists, if not then create it
>     If Dir(ToPath, vbDirectory) = "" Then
>         MkDir ToPath
>     End If
>
>     Set FSO = CreateObject("scripting.filesystemobject")
>
>     For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
>        ' Move each photo to new folder one at a time
>         FileInFromFolder.Move ToPath
>     Next FileInFromFolder
>
>     End With
>
>
>
>
> --
> Jeff Barrows
> MCP, MCAD, MCSD
>
> Outbak Technologies, LLC
> Racine, WI
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>



-- 
Paul Hartland
paul.hartland at googlemail.com


More information about the AccessD mailing list