VBA - Import Script

gripper

Board Regular
Joined
Oct 29, 2002
Messages
176
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.

VBA Code:
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
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
VBA Code:
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
 
Upvote 1

Forum statistics

Threads
1,223,893
Messages
6,175,241
Members
452,622
Latest member
Laura_PinksBTHFT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top