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
Thank you in advance for your assistance and guidance.
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.
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