VBA - Import Script

[gripper]

I have some code that I have been working on today and having some errors

I am trying to create an import script to import a .txt file into a new sheet and name it automatically

What I am trying to do is these steps

• open the file picker and go to my desktop and filter to only .txt or .csv files (removing the rest of the clutter)
• Select the file. Example "mytest.txt"
• Save this and strip the file path and file extension only leaving "mytest" for now
• Next append todays date in a short date format of "mm-dd" so now my file will look like "mytest_01-31" - adding an underscore between each piece
• Then next search the current workbook and if there is another sheet named "mytest_01-31" then add a version number so it will now look like "mytest_01-31(1)". This should increment so if there is already "mytest_01-31(1)" then it should increment to "mytest_01-31(2)" and so on. My issue is that often I have to import several data sets a day to analyze and this is a reasonable way to differentiate
• Now apply this newly created name to a new sheet on the current workbook
• Then import that file that was select in a common delimited fashion only.

Here is my latest VBA coding attempt. I get errors of the sheet already exist.

Thank you in advance for your assistance and guidance.

Sub ImportDataFromFile2()

    Dim fd As FileDialog
    Dim selectedFile As String
    Dim newSheetName As String
    Dim newSheet As Worksheet
    Dim lastDigit As Integer
    Dim existingSheet As Boolean
    
    ' Create a File Dialog object
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    ' Filter for .txt and .csv files
    fd.Filters.Clear
    fd.Filters.Add "Text and CSV files", "*.txt; *.csv"
    
    ' Set the initial folder to the desktop
    fd.InitialFileName = Environ("USERPROFILE") & "\Desktop"
    
    ' Show the File Dialog
    If fd.Show = -1 Then
        selectedFile = fd.SelectedItems(1)
        newSheetName = Replace(Mid(selectedFile, InStrRev(selectedFile, "\") + 1), ".txt", "")
        newSheetName = Replace(newSheetName, ".csv", "") & " " & Format(Date, "M-D")
        
        ' Check if a sheet with the same name exists
        existingSheet = False
        For Each ws In ThisWorkbook.Sheets
            If ws.Name = newSheetName Then
                existingSheet = True
                If IsNumeric(Right(ws.Name, 1)) Then
                    lastDigit = Int(Right(ws.Name, 1))
                    If lastDigit >= lastDigit Then
                        lastDigit = lastDigit + 1
                    End If
                Else
                    lastDigit = 1
                End If
                Exit For
            End If
        Next
        
        If existingSheet Then
            newSheetName = newSheetName & " (" & lastDigit & ")"
        End If
        
        ' Create a new sheet with the specified name
        Set newSheet = ThisWorkbook.Sheets.Add
        newSheet.Name = newSheetName
        
        ' Import the data from the selected file to the new sheet
        With newSheet.QueryTables.Add(Connection:="TEXT;" & selectedFile, Destination:=Range("A1"))
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    End If
     
End Sub

 

[rakesh seebaruth]

Sub rakesh()

Dim filePath As String
Dim fileName As String
Dim sheetName As String
Dim today As String
Dim version As Integer

' Open the file picker and filter to .txt or .csv files
filePath = Application.GetOpenFilename(fileFilter:="Text Files (*.txt),*.txt,CSV Files (*.csv),*.csv", Title:="Select a File")

' Check if a file was selected
If filePath <> False Then

  ' Strip file path and extension
  fileName = Mid(filePath, InStrRev(filePath, "\") + 1)
  fileName = Left(fileName, InStr(fileName, ".") - 1)

  ' Append today's date
  today = Format(Date, "mm-dd")
  sheetName = fileName & "_" & today

  ' Check if a sheet with the same name exists
  version = 1
  While SheetExists(sheetName)
    sheetName = fileName & "_" & today & "(" & version & ")"
    version = version + 1
  End While

  ' Create a new sheet and name it
  Dim newSheet As Worksheet
  Set newSheet = ThisWorkbook.Sheets.Add
  newSheet.Name = sheetName

  ' Import the file
  newSheet.QueryTables.Add filePath, newSheet.Range("A1"), xlDelimited

Else
  MsgBox "No file was selected."
End If

End Sub

Function SheetExists(sheetName As String) As Boolean

SheetExists = False

For Each ws In ThisWorkbook.Sheets
  If ws.Name = sheetName Then
    SheetExists = True
    Exit Function
  End If
Next ws

End Function

 

[gripper]

Rakesh

I integrated this code into my workbook it is correctly and runs great.

Thank you