Save file as folder name/sheets as file name

Vbanoob98

Board Regular
Joined
Sep 13, 2019
Messages
108
Hi I would like to change this code to save the file as the folders name instead of "Total Results.xlsm"

Also I'm trying to name the worksheets the same as the files that its importing instead of "Data" & i +1

Thanks a lot to anyone that can help


Code:
Sub ImportCSVData()

Dim wb As Workbook
Dim wbCSV As Workbook
Dim myPath As String
Dim myFile As Variant
Dim fileType As String
Dim i As Integer

'Get Target Folder Path From User
 With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Source Folder"
        .AllowMultiSelect = False
        .Show
'  changed the following line - added the backslash to the path
        myPath = .SelectedItems(1) & "\"
    End With

'Specify file type
  fileType = "*.csv*"

'Target Path with file type
  myFile = Dir(myPath & fileType)

'Add Target Workbook
 Workbooks.Add
'  changed the following line - removed leading space in file name
 ActiveWorkbook.SaveAs Filename:= _
        myPath & "Total Results.xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'  changed the following line - removed leading space in file name
Set wb = Workbooks.Open(myPath & "Total Results.xlsm")

'Loop through each Excel file in folder
'  changed the following line - to test myFile against a null string, rather than a value of 0
  Do While myFile <> ""
    Worksheets.Add(Before:=Worksheets("Sheet1")).Name = "Data " & i + 1
'changed the following line - from *.csv to myFile ** This was probably what was causing the error
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myPath & myFile _
            , Destination:=ActiveSheet.Range("$A$1"))
            .Name = myFile
            .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(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
            1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False    'Error occurs here!
        End With
    i = i + 1
    myFile = Dir
    
  Loop

'Message Box when tasks are completed
  MsgBox "Result Import Complete"

End Sub
 

Some videos you may like

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

daverunt

Well-known Member
Joined
Jul 9, 2009
Messages
1,821
Office Version
2013
Platform
Windows
Hi,

I've just posted the code where changes are made...

Code:
'  changed the following line - added the backslash to the path
myPath = .SelectedItems(1) & "\"
a = Split(myPath, "\")
myFolderName = a(UBound(a) - 1)

    End With

'Specify file type
  fileType = "*.csv*"

'Target Path with file type
myFile = Dir(myPath & fileType)
myFileName = (Left(myFile, Len(myFile) - 4))
 

'Add Target Workbook
Workbooks.Add
' changed the following line - removed leading space in file name
ActiveWorkbook.SaveAs Filename:= _
myPath & myFolderName, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
' changed the following line - removed leading space in file name
Set wb = Workbooks.Open(myPath & myFolderName)

'Loop through each Excel file in folder
' changed the following line - to test myFile against a null string, rather than a value of 0
Do While myFile <> ""
    Worksheets.Add(Before:=Worksheets("Sheet1")).Name = myFileName
 

Watch MrExcel Video

Forum statistics

Threads
1,102,552
Messages
5,487,525
Members
407,604
Latest member
sama9000

This Week's Hot Topics

Top