Cross check two file types in two folders

[Shaun]

Hi All

I have a series of .csv files which I need import and save as .xlsx files. The .csv files over time will change with deletions and additions and the files getting additional data periodically. I have recorded and utilised existing code to cycle through the list of .csv files in the directory to import the data then save as an .xlsx file:

Sub LoopThroughFiles()

Dim StrFile As String
Dim FileName As String
Application.ScreenUpdating = False
  StrFile = Dir("c:\Data\CSV\*")
  Do While Len(StrFile) > 0
  Workbooks.Add
  With ActiveSheet.QueryTables.Add(Connection:= _
  "TEXT;C:\Data\CSV\" & StrFile, Destination:=Range("$A$1"))
  .Name = StrFile
  .FieldNames = True
  .RowNumbers = False
  .FillAdjacentFormulas = False
  .PreserveFormatting = True
  .RefreshOnFileOpen = False
  .RefreshStyle = xlInsertDeleteCells
  .SavePassword = False
  .SaveData = True
  .AdjustColumnWidth = True
  .RefreshPeriod = 0
  .TextFilePromptOnRefresh = False
  .TextFilePlatform = 850
  .TextFileStartRow = 1
  .TextFileParseType = xlDelimited
  .TextFileTextQualifier = xlTextQualifierDoubleQuote
  .TextFileConsecutiveDelimiter = False
  .TextFileTabDelimiter = False
  .TextFileSemicolonDelimiter = True
  .TextFileCommaDelimiter = False
  .TextFileSpaceDelimiter = False
  .TextFileColumnDataTypes = Array(4, 1, 1, 1, 1, 1, 1, 1)
  .TextFileTrailingMinusNumbers = True
  .Refresh BackgroundQuery:=False
  End With
  FileName = Left(StrFile, Len(StrFile) - 4)
  ActiveWorkbook.SaveAs FileName:="c:\Data\Excel\" & FileName & ".xlsx", _
  FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
  Workbooks(FileName & ".xlsx").Close
  Debug.Print StrFile
  StrFile = Dir
  Loop
Application.ScreenUpdating = True
End Sub

Is this the most efficient way of performing this task?

What I can't manage to do is check to see if the .xlsx file exists before proceeding with the import and file creation. If the .xlsx file exists I want the file skipped and move onto the next .csv file in the CSV directory.

The file names for both are identical except for the .csv and .xlsx.

Here is my current test effort which is failing miserably to perform the cross check and output the resulting test as a MsgBox:

Sub CheckFileExists()

Dim StrFile As String
Dim ChkFile As String
Dim ChkFilePath As String

StrFile = Dir("c:\Data\CSV\*")
ChkFilePath = "c:\Data\Excel\"

  Do While Len(StrFile) > 0
  ChkFile = Left(StrFile, Len(StrFile) - 4) & ".xlsm"
  Debug.Print ChkFilePath; ChkFile
'  If Dir(ChkFilePath & ChkFile) = vbNullString Then
'  MsgBox "File Exists"
'  Else
'  MsgBox "File Does Not Exist"
'  End If
   
  Debug.Print StrFile
  StrFile = Dir
  'ChkFile = Left(StrFile, Len(StrFile) - 4) & ".xlsm"
  Loop

End Sub

I just can't seem to get it to work. Does anyone have any pointers to get me on the right track?

Cheers

Shaun

 

[shrivallabha]

Maybe because you were trying to run to Dir simultaneously it did not work. Try this and see if it works for you.

Option Explicit
Sub CheckFileExists()
Dim iCnt As Integer
Dim strFile As String, strList() As String
'\\ Check only csv files
strFile = Dir("C:\Data\CSV\*.csv")
If strFile = vbNullString Then
  MsgBox "No files found with matching criteria!", vbExclamation
  Exit Sub
End If
'\\ If number of files always exceed 1000 then change it to suitable number
'\\ so that we don't have redim it frequently
ReDim strList(1000)
Do While Len(strFile) > 0
  '\\ Resize it in chunk if we need to
  If iCnt > UBound(strList) Then
  ReDim Preserve strList(UBound(strList) + 1000)
  End If
  '\\ Write into an array which we check later using Dir function
  strList(iCnt) = "C:\Data\Excel\" & Left(strFile, Len(strFile) - 4) & ".xlsm"
  iCnt = iCnt + 1
  strFile = Dir
Loop
'\\ Remove empty elements
ReDim Preserve strList(iCnt - 1)
'\\ Loop through all found elements of array and check if exists
For iCnt = LBound(strList) To UBound(strList)
  If Dir(strList(iCnt)) <> vbNullString Then
  MsgBox strList(iCnt) & " : file exists!", vbInformation
  Else
  MsgBox strList(iCnt) & " : file does not exist!", vbExclamation
  End If
Next
End Sub

 

[Shaun]

Hi Shrivallabha

Thank you very much for your reply. The VBA code you posted is exactly what I was trying to achieve. Now to see how it works.

Again, Thank you for your help, I greatly appreciate it.

Cheers

Shaun