Type Mismatch error because macro only applicable to .xls - files and not .csv

[Nico45]

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

[Paul_Hossler]

Not elegant and not tested

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
   
   sPattern = "*.cs*"
   sFile = Dir(sPath & sPattern)
   Do Until sFile = ""
      sFileList = sFileList & sFile & ","
      sFile = Dir()
   Loop


   readSourceFiles = Split(sFileList, ",")
 
End Function

[Nico45]

Hi Paul,

thx for this.
Unfortunately it leads to the same error message. From my recent research, the problem is likely to be linked to the fact that CSV files are just comma seperated text files. That's why it doesn't work the same way as with xls files. From what I've read, the csv file needs to be read into an array. The two cells that need to be changed however, have to be identified in the array before they are changed. After that, the array has to be changed back to the CSV file as it was before.

I found a code that would cover part of the transformation but probably not all of it:

Sub Csvreadtest()

 Dim flname
 Dim FileNum As Integer
 Dim Counter As Long, maxrow As Long
 Dim WorkResult As String
 Dim ws As Worksheet
 Dim i As Long
  
 maxrow = Cells.Rows.Count
 MsgBox "Select Data File"
 flname = Application.GetOpenFilename(FileFilter:= _
 "Text file (*.prn;*.txt;*.csv;*.dat),*.prn;*.txt;*.csv;*.dat" _
 , MultiSelect:=False)
  
 If VarType(flname) = vbBoolean Then
 Exit Sub
 End If
  
 Application.ScreenUpdating = False
 Application.EnableEvents = False
  
 Set ws = ActiveWorkbook.ActiveSheet
  
 Counter = Cells(Cells.Rows.Count, "A").End(xlUp).Row
  
 If Counter <> 1 Then
 Counter = Counter + 1
 End If
  
 FileNum = FreeFile()
  
 Open flname For Input As #FileNum
  
 Do While Not EOF(FileNum)
 If Counter > maxrow Then
 MsgBox "Reached max row"
 Exit Sub
 End If
 Line Input #FileNum, WorkResult
 Cells(Counter, "A") = WorkResult
 Application.DisplayAlerts = False
 Cells(Counter, "A").TextToColumns Destination:= _
 Cells(Counter, "A"), DataType:=xlDelimited, _
 TextQualifier:=xlDoubleQuote, _
 ConsecutiveDelimiter:=False, _
 Tab:=False, Semicolon:=False, _
 Comma:=True, Space:=False, _
 Other:=False, _
 FieldInfo:=Array(Array(1, 1), Array(2, 4)) '<==change here
 Counter = Counter + 1
 Loop
 Close #FileNum
  
 ws.Columns("B").NumberFormat = "dd/mm/yyyy" '<==change here
  
 Application.EnableEvents = True
 Application.ScreenUpdating = True
  
 End Sub

So thanks to all for further input

[snb]

Keep it 'Einfach'

Sub M_snb()
  c00="G:\OF\"

  sn=filter(split(createobject("wscript.shell").exec("cmd /c Dir """ & c00 & "*.csv"" /b/a/s").stdout.readall,vbcrlf),".")

  for j=0 to ubound(sn)
    with getobject(it)      
       .Sheets(1).Range("T2").resize(,2).value = iif(.Sheets(1).Range("U2").value="big",array("small","smaller"),array("big","bigger"))
       .close -1
    end with
  next
End Sub