PDA

View Full Version : Move files with path as argument



nvnispen
10-01-2018, 03:07 AM
Dear community,

I have been working on a macro that automates data extraction from excel files. Those excel files come in at a central place / path. The macro I have written extracts the data to a master file. After the extraction I want to move the file from the central place to a dedicated folder. I experience some problems with handling the excel file path at that central place, named sourceFilePath. In the movefiles function I made to msgBox's, while running the code it provides the message "
sourceFilePath & " does not exists 1.
".

If someone that kind to have a look at the code displayed below?

Many thanks in advance,

Nick



Sub Button1_Click()


Dim initiativeName As String
Dim initiativeNPV As Single
Dim consolidateData As Workbook
Dim wbThis As Workbook
Dim IC As Workbook
Dim consolidatePath As String
Dim investmentCardPath As String
Dim fso As Scripting.FileSystemObject
Dim fil As Scripting.file
Dim InvestmentCardFolder As Scripting.Folder


consolidatePath = "C:\Desktop\Excel environment\Consolidate Investment Cards.xlsm"
investmentCardPath = "C:\Desktop\Excel environment\Investment cards"


Set fso = New Scripting.FileSystemObject
Set InvestmentCardFolder = fso.GetFolder(investmentCardPath)
Set wbThis = ThisWorkbook


For Each fil In InvestmentCardFolder.Files
If Left(fso.GetFileName(fil.path), 2) = "In" Then
Set IC = Workbooks.Open(fil.path)
With IC
'Filename
IC.Sheets("Investment Card").Range("L55").Select
Selection.Copy
wbThis.Worksheets("Sheet3").Range("A500").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
'name investment
IC.Sheets("Investment Card").Range("K10").Select
Selection.Copy
wbThis.Worksheets("Sheet3").Range("B500").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

Workbook_Open --> to save the state of the wb
IC.Close --> closing the wb
Call MoveFiles(fil.path) --> want to move the wb by calling the MoveFiles function with the path as argument.
End With
End If
Next fil

Set fso = Nothing


End Sub

---

Private Sub Workbook_Open()
ActiveWorkbook.Saved = True
End Sub
---

Sub MoveFiles(path As String)

Dim fso, destinationFolder, file As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim sourceFilePath, fileName As String
Dim destinationFolderPath As String 'gebruik deze

sourceFilePath = path --> source of the file
destinationFolderPath = "C:\Desktop\Excel environment\IC's done" --> the new destination

Set fso = New Scripting.FileSystemObject

Set destinationFolder = fso.GetFolder(destinationFolderPath)

If fso.FolderExists(sourceFilePath) = False Then
MsgBox sourceFilePath & " does not exists 1."
Exit Sub
End If

If fso.FolderExists(destinationFolderPath) = False Then
MsgBox sourceFilePath & " does not exists 2."
Exit Sub
End If


FileCopy sourceFilePath, destinationFolderPath


fso.MoveFile Source:=sourceFilePath, Destination:=destinationFolderPath


Set fso = Nothing


End Sub

werafa
10-01-2018, 03:41 PM
Hi,

'Dim sourceFilePath, fileName As String'

defines sourcelilepath as variant, and filename as string (not a dealbreaker)

Can you read the value of sourcefilepath before it is processed, and confirm that the string is as required?

I personally use this check method - try it to validate your check method vs check string


Function GetDefaultLocation(ByVal myString As String) As String
Dim folderExists As Boolean

On Error Resume Next
folderExists = (GetAttr(myString) And vbDirectory) = vbDirectory
On Error GoTo 0

If folderExists Then
GetDefaultLocation = myString
Else
GetDefaultLocation = Application.ThisWorkbook.Path
End If


End Function

Werafa

nvnispen
10-08-2018, 05:35 AM
Hi Werafa,

Thanks for your response, I managed to solve it with this function. The problem was solved passing another argument instead of fil.path, and added another step "entireSourcePath" in the MoveFiles function.

Nick

Sub MoveFiles(path As String)


Dim fso, destinationFolder, file As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim sourceFilePath, entireSourcePath As String
Dim destinationFolderPath As String


sourceFilePath = "fixed folder"
entireSourcePath = (sourceFilePath & path)
destinationFolderPath = "fixed folder"


Set fso = New Scripting.FileSystemObject


If fso.FileExists(entireSourcePath) = False Then
MsgBox entireSourcePath & " does not exists 1."
Exit Sub
End If


If fso.FolderExists(destinationFolderPath) = False Then
MsgBox destinationFolderPath & " does not exists 2."
Exit Sub
End If


fso.MoveFile Source:=entireSourcePath, Destination:=destinationFolderPath

Set fso = Nothing


End Sub