move files to another folder delete original

**D_Rennie** · 09-08-2009, 05:56 AM

hello.

i would like to be able to move files from one folder to another then delete the original files.
I dont think im passsing the variables to the functions corectly.
been trying this for a while now and cant get it.

Sub Move_DeleteFiles()
Dim var_File
Dim int_FileCount As Integer
Dim str_FileName As String
Dim str_FileExt As String
Dim str_FileNameExt As String

var_File = Application.GetOpenFilename _
(Title:="Please select the Files you wish to import.", _
MultiSelect:=True)

        If IsArray(var_File) Then
            For int_FileCount = 1 To UBound(var_File)
            str_FileName = ExtractFileName(var_File(int_FileCount))
            str_FileExt = GetFileType(var_File(int_FileCount))
            str_FileNameExt = str_FileName & str_FileExt
                FileCopy var_File, _
                ("C:\Documents and Settings\1 1\Desktop\Test2\" & str_FileNameExt)
            Next int_FileCount
        End If
        
'Kill var_File
End Sub

Function ExtractFileName(var_File As String) As String
' extract filename portion of filename, no extension
Dim str_FileName As String

str_FileName = Right(filename, Len(var_File(int_FileCount)) - InStrRev(var_File(int_FileCount), "\"))
str_FileName = Replace(fileN, GetFileType(str_FileName), "")

ExtractFileName = str_FileName

End Function

Function GetFileType(var_File As String) As String
' get file extension
GetFileType = Mid$(var_File(int_FileCount), InStrRev(var_File(int_FileCount), "."), Len(var_File(int_FileCount)))

End Function

and help would greatly be appresated.

cheers

**royUK** · 09-08-2009, 06:05 AM

Check this page

http://www.rondebruin.nl/folder.htm

**D_Rennie** · 09-08-2009, 06:39 AM

im still strugling. im thinking from the examples on the link, they are not to diffrent to what im trying.

though becouse im using application.getopenfilename to select mutipul files. I figured that the files needed to be stored in a array and then loop through to deal with each seperate file. and this is where im lost the file name will change for however many times for the files in the array. from that im trying to extract the file name and file extention to be used for the new location naming.

hope that makes sence.

**pike** · 09-08-2009, 07:00 AM

Hey D_Rennie

Dim e!, a$, i!
    i = Len(ThisWorkbook.Name)
    e = InStrRev(ThisWorkbook.Name, ".")
    a = Mid(ThisWorkbook.Name, e, i)
MsgBox "Extension = " & a

Private Function FileNameOnly(myFilename$)
Dim StartStrgOne&
    StartStrgOne = InStrRev(myFilename, ".")
    FileNameOnly = Mid(myFilename, 1, StartStrgOne)
End Function

does this help?

**D_Rennie** · 09-08-2009, 08:31 AM

hay pike how you going???

It helped me to understand it better.

i now got the filename and extention extracted fine though its the array that is stuffing me up

Sub sse()
Dim var_File
Dim int_FileCount As Integer

var_File = Application.GetOpenFilename _
(Title:="Please select the Files you wish to import.", _
MultiSelect:=True)

        If IsArray(var_File) Then
            For int_FileCount = 1 To UBound(var_File)


Dim filename As String
filename = GetFileType(var_File(int_FileCount))
MsgBox filename
Next int_FileCount
End If
End Sub

even this error out

im about to scrap this idear and just use a groupe of cells for each complete filepath and extracted filepath.

the reason that have tryed to get this to work so long is i aready had the array from attaching the files to a email so though the move wouldnt be to hard.

Thankyou for the help.

**pike** · 09-08-2009, 05:09 PM

Hey D_Rennie

any thing can be done

what do you need
1 select File
and 2 move it

**pike** · 09-08-2009, 05:41 PM

Dude
from Julitta Korol

Option Explicit

Sub CopyToAbort()
    Dim folder As String
    Dim source As String
    Dim dest As String
    Dim msg1 As String
    Dim msg2 As String
    Dim p As Integer
    Dim s As Integer
    Dim i As Long
    
    On Error GoTo ErrorHandler

    folder = "C:\Abort"
    msg1 = "The selected file is already in this folder."
    msg2 = "was copied to"
    p = 1
    i = 1
    'get the name of the file from the user
    source = Application.GetOpenFilename
    'don't do anything if cancelled
    If source = "False" Then Exit Sub
    'get the total number of backslash characters "\" in the source variable's 'contents
    Do Until p = 0
        p = InStr(i, source, "\", 1)
        If p = 0 Then Exit Do
        s = p
        i = p + 1
    Loop
    ' create the destination file name
    dest = folder & Mid(source, s, Len(source))
        'create a new folder with this name
        MkDir folder
        ' check if the specified file already exists in the destination folder
        If Dir(dest) <> "" Then
            MsgBox msg1
        Else
        ' copy the selected file to the C:\Abort folder
            FileCopy source, dest
            MsgBox source & " " & msg2 & " " & dest
        End If
       Exit Sub
ErrorHandler:
    If Err = "75" Then
        Resume Next
    End If
    If Err = "70" Then
        MsgBox "You can't copy an open file."
        Exit Sub
    End If
End Sub

Sub RemoveMe()
    Dim folder As String
    Dim myFile As String

    'assign the name of folder to the folder variable
    'notice the ending backslash "\"
    folder = "C:\Abort\"
    myFile = Dir(folder, vbNormal)
    Do While myFile <> ""
        Kill folder & myFile
        myFile = Dir
    Loop
    RmDir folder
End Sub

**D_Rennie** · 09-08-2009, 08:53 PM

Hay pike.

Cheers for the code. I will use most of that for what im doing, It has some great error handling. What i was trying to do was use the getopenfile in an array.

so where it has [code]source = Application.GetOpenFilename[code]
use

    'source = variant
source = Application.GetOpenFilename(Title:="Please select the Files you wish to import.", _
MultiSelect:=True)

The programing needed to get it working has getting the better or me.

So the answer for this one is going to be what is a probley better way anyhow. This way i can store all the file information on a spreadsheat and use some of this within the email sendout.

I will loop through the array and store the original file path in column A"aready tryed this and works fine. Also pull the file name+Ext and file size for column B & C. Then use the code you gave me to loop through the files from column A to transpher to a newley created folder. Kill the original files. Then use the thansphered files for attaching to a email"also done this works fine"

So going this way it is quite simple and would have been done long ago. Though im like a fly in a horse padic when im trying somethink new, Cant get me off the ++++ until i figure it out, or the ++++ sumthers me.

Ill mark solved, Though post back the code that i will run with.

Cheers for all the help, Many thanks.

**D_Rennie** · 09-09-2009, 02:50 AM

Here is what i am going to run with, Just incase you where intrested.
Cells D1-E1 must cointain text, and must not contain illegal charters /-? ect
Note this will delete the original file after it is placed into the new folder.

Option Explicit

Sub Move_DeleteFiles()
Dim var_File
Dim int_FileCount As Integer
Dim str_Folder As String
Dim rng_Cell

var_File = Application.GetOpenFilename _
(Title:="Please select the Files you wish to import.", _
MultiSelect:=True)

        If IsArray(var_File) Then
            For int_FileCount = 1 To UBound(var_File)
                Cells(int_FileCount, 1).Value = var_File(int_FileCount)
                Cells(int_FileCount, 2).Value = FileNameWithExt(Cells(int_FileCount, 1).Value)
            Cells(int_FileCount, 3).Value = FileLen(var_File(int_FileCount)) & " bytes"
            Next int_FileCount
        End If
        
    str_Folder = "C:\" & Cells(1, 4).Value & " " & Cells(1, 5).Text
    
    If Dir(str_Folder) <> "" Then
        MkDir str_Folder
    End If
    
        For Each rng_Cell In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
            FileCopy rng_Cell.Value, str_Folder & "\" & rng_Cell.Offset(0, 1).Value
            Kill rng_Cell.Value
                ActiveSheet.Hyperlinks.Add _
                    Anchor:=rng_Cell, _
                    Address:=str_Folder & "\" & rng_Cell.Offset(0, 1).Value, _
                    TextToDisplay:=rng_Cell.Offset(0, 1).Value
        Next rng_Cell
        
                ActiveSheet.Hyperlinks.Add _
                    Anchor:=Cells(1, 1)(Rows.Count).End(xlUp).Offset(1, 0), _
                    Address:=str_Folder & "\", _
                    TextToDisplay:="Open Contaning Folder"
                    
        Cells(1, 1)(Rows.Count).End(xlUp).Offset(1, 0).Value = int_FileCount - 1 _
        & " Image Attachments"
                
End Sub

Function FileNameWithExt(strPath As String) As String
    FileNameWithExt = Mid$(strPath, InStrRev(strPath, "\") + 1)
End Function