Prevent excel form remembering connection and copying the filename.

[zohaib]

Hello,

So I have two questions on the code below. can you help me modify this code to make the Q1 and Q2 work?


Q1. How to I prevent the code below from memorizing the "workbook connections" in menu data>connections. i need to import the data only without the data connection.

Q2. How to I take the imported file name (ex. Submission Review 02.09.16.xlsx) and give that name to my sheet1 (Submission Review 02.09.16) where the data was just imported? fyi, I open new excel file and then run the code below from dev>macros so the (sheet1) needs to show imported file name which would be "Submission Review 02.09.16." in this case.

thanks in advance for your help.

Sub Submission_Review()
'
' Submission Review Macro
'

'
    Dim Filt As String
    Dim FilterIndex As Integer
    Dim Title As String
    Dim FileName As Variant

    Filt = "xls Files (*.xls),*.xls," & _
        "All Files (*.*),*.*"

    FilterIndex = 1

    Title = "Select a Submission Report"

    FileName = Application.GetOpenFilename _
        (FileFilter:=Filt, _
        FilterIndex:=FilterIndex, _
        Title:=Title)

    If FileName = False Then
        MsgBox "No file was selected."
        Exit Sub
    End If
   
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & FileName, Destination:= _
        Range("$A$1"))
        '.CommandType = 0
        .Name = "Submission Review"
        .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 = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

 

[Marc L]

Hi !

A1. Insert .Delete just after Refresh codeline …

A2. ActiveSheet.Name = Replace(Filename, ".xlsx", "")
​

 

[zohaib]

Hello Marc,

A1- worked perfect.
A2 -doesn't work? i'm thinking it could be because the ".delete" function in step A1? im not sure.

Sub Submission_Review()
'
' Submission Review Macro
'

'
    Dim Filt As String
    Dim FilterIndex As Integer
    Dim Title As String
    Dim FileName As Variant
' Set up list of file filters
    Filt = "xls Files (*.xls),*.xls," & _
        "All Files (*.*),*.*"
' Display Text Files by default
    FilterIndex = 1
' Set the dialog box caption
    Title = "Select a Submission Report"
' Get the file name
    FileName = Application.GetOpenFilename _
        (FileFilter:=Filt, _
        FilterIndex:=FilterIndex, _
        Title:=Title)
' Exit if dialog box is canceled
    If FileName = False Then
        MsgBox "No file was selected."
        Exit Sub
    End If
' Import text file as fixed width.

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & FileName, Destination:= _
        Range("$A$1"))
        '.CommandType = 0
        '.Name = "Submission Review"
        .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 = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        .Delete
       
    End With
ActiveSheet.Name = Replace(Filename, ".xlsx", "")
End Sub

 

[zohaib]

ok so the imported file is a .xls file so I changed the code to: ActiveSheet.Name = Replace(FileName, ".xls", "") but still no luck?

 

[Marc L]

My bad (forgot to remove drive and folder) ! A2 whatever file extension :​

                  SP = Split(Filename, "\")
    ActiveSheet.Name = Left(SP(UBound(SP)), InStrRev(SP(UBound(SP)), ".") - 1)

If it's always a .xls file, amend second codeline :

ActiveSheet.Name = Replace(SP(UBound(SP)), ".xls", "") …
​

 

[zohaib]

OMG it works now

Thanks soooooo much.

Zohaib