Nico45
11-24-2014, 08:16 AM
Hello all,
I'm new to this forum so I'd like to quickly introduce myself: I'm a bloody beginner in VBA but have to get together a code to solve the below stated problem: thus, I'm seeking help of you experts :) ... Of course, I've searched the forum before but none of what I've found matches my specific problem.
The macro opens all Excel files in the source folder, adjusts a couple of values in those files and then moves the files to another designated folder.
Everything works great but only as long as there are only .xls files in the source folder. However, I recently realized that the source folder only contains .csv files instead of .xls files.
Option Explicit
Sub doTheMagic()
Dim sSrcDir As String
Dim sTargetDir As String
Dim aSrcFiles() As String
Dim cur_file As String
Dim src_value As String
Dim i As Long
sSrcDir = getSrcDir()
sTargetDir = getTargetDir()
aSrcFiles = readSourceFiles(sSrcDir)
If Len(Join(aSrcFiles)) = 0 Then
MsgBox "Das Quellverzeichnis ist leer!"
Exit Sub
End If
For i = 0 To UBound(aSrcFiles) - 1
cur_file = aSrcFiles(i)
src_value = readValueFromExternalFile(sSrcDir, cur_file, "U2")
Dim WbDatei As Workbook
Set WbDatei = Workbooks.Open(sSrcDir & cur_file, ReadOnly:=False)
If src_value = "big" Then
' write values to file
WbDatei.Sheets("Tabelle1").Range("U2").value = "small"
WbDatei.Sheets("Tabelle1").Range("T2").value = "smaller"
Else
WbDatei.Sheets("Tabelle1").Range("U2").value = "big"
WbDatei.Sheets("Tabelle1").Range("T2").value = "bigger"
End If
WbDatei.Save
WbDatei.Close
Call moveFile(sSrcDir & "\" & cur_file, sTargetDir & "\" & cur_file)
Next i
End Sub
Private Function GetValue(pfad, datei, blatt, zelle)
Dim arg As String
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
If Dir(pfad & datei) = "" Then
GetValue = "datei Not Found"
Exit Function
End If
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function
Private Function readValueFromExternalFile(sPath, sFile, sCell)
Dim blatt As String
blatt = "Tabelle1"
readValueFromExternalFile = (GetValue(sPath, sFile, blatt, sCell))
End Function
Private Function readSourceFiles(ByVal sPath As String) As String()
Dim sFile As String, sPattern As String
Dim sFileList As String
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sPattern = "*.xl*"
sFile = Dir(sPath & sPattern)
Do Until sFile = ""
sFileList = sFileList & sFile & ","
sFile = Dir()
Loop
readSourceFiles = Split(sFileList, ",")
End Function
Private Function getSrcDir() As String
getSrcDir = Worksheets("config").Range("b2").value
End Function
Private Function getTargetDir() As String
getTargetDir = Worksheets("config").Range("b3").value
End Function
Private Sub moveFile(sSrc As String, sTarget As String)
Name sSrc As sTarget
End Sub
However, simply changing
sPattern = "*.xl*"
to
sPattern = "*.cs*"
doesn't do the trick.
Does anybody know how the below code needs to be adjusted in order to work with .csv files?
Thanks a lot!!!
Nico
I'm new to this forum so I'd like to quickly introduce myself: I'm a bloody beginner in VBA but have to get together a code to solve the below stated problem: thus, I'm seeking help of you experts :) ... Of course, I've searched the forum before but none of what I've found matches my specific problem.
The macro opens all Excel files in the source folder, adjusts a couple of values in those files and then moves the files to another designated folder.
Everything works great but only as long as there are only .xls files in the source folder. However, I recently realized that the source folder only contains .csv files instead of .xls files.
Option Explicit
Sub doTheMagic()
Dim sSrcDir As String
Dim sTargetDir As String
Dim aSrcFiles() As String
Dim cur_file As String
Dim src_value As String
Dim i As Long
sSrcDir = getSrcDir()
sTargetDir = getTargetDir()
aSrcFiles = readSourceFiles(sSrcDir)
If Len(Join(aSrcFiles)) = 0 Then
MsgBox "Das Quellverzeichnis ist leer!"
Exit Sub
End If
For i = 0 To UBound(aSrcFiles) - 1
cur_file = aSrcFiles(i)
src_value = readValueFromExternalFile(sSrcDir, cur_file, "U2")
Dim WbDatei As Workbook
Set WbDatei = Workbooks.Open(sSrcDir & cur_file, ReadOnly:=False)
If src_value = "big" Then
' write values to file
WbDatei.Sheets("Tabelle1").Range("U2").value = "small"
WbDatei.Sheets("Tabelle1").Range("T2").value = "smaller"
Else
WbDatei.Sheets("Tabelle1").Range("U2").value = "big"
WbDatei.Sheets("Tabelle1").Range("T2").value = "bigger"
End If
WbDatei.Save
WbDatei.Close
Call moveFile(sSrcDir & "\" & cur_file, sTargetDir & "\" & cur_file)
Next i
End Sub
Private Function GetValue(pfad, datei, blatt, zelle)
Dim arg As String
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
If Dir(pfad & datei) = "" Then
GetValue = "datei Not Found"
Exit Function
End If
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function
Private Function readValueFromExternalFile(sPath, sFile, sCell)
Dim blatt As String
blatt = "Tabelle1"
readValueFromExternalFile = (GetValue(sPath, sFile, blatt, sCell))
End Function
Private Function readSourceFiles(ByVal sPath As String) As String()
Dim sFile As String, sPattern As String
Dim sFileList As String
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sPattern = "*.xl*"
sFile = Dir(sPath & sPattern)
Do Until sFile = ""
sFileList = sFileList & sFile & ","
sFile = Dir()
Loop
readSourceFiles = Split(sFileList, ",")
End Function
Private Function getSrcDir() As String
getSrcDir = Worksheets("config").Range("b2").value
End Function
Private Function getTargetDir() As String
getTargetDir = Worksheets("config").Range("b3").value
End Function
Private Sub moveFile(sSrc As String, sTarget As String)
Name sSrc As sTarget
End Sub
However, simply changing
sPattern = "*.xl*"
to
sPattern = "*.cs*"
doesn't do the trick.
Does anybody know how the below code needs to be adjusted in order to work with .csv files?
Thanks a lot!!!
Nico