Sub ImportAppReport()
Dim fName As FileDialog, result As Integer, it As Variant, LastRow As Long
Dim myVal1 As Variant
Dim myValn As String
Dim Cml As Worksheet
Dim Aud As Worksheet
Set Aud = Worksheets("CURRENT")
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "OLD"
Set Cml = Worksheets("OLD")

    'find folder by userinput date'
        myVal1 = InputBox("Please enter today's date in mm-dd format")
        myValn = Replace(myVal1, "-", "")

fName = Application.FileDialog(msoFileDialogOpen)
If fName = "False" Then Exit Sub

LastRow = Range("A" & Rows.Count).End(xlUp).Row + 1

    With ActiveSheet.QueryTables.Add(Connection:="\olscmesf003gcm_emeaTCU_REPORTSAPPSReportsRegionalPointsec for PC  Web RH2017" & myValn, _
        Destination:=Range("A" & LastRow))
            .Name = "sample"
            .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 = xlTextQualifierNone
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = "" & Chr(10) & ""
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, _
               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 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
    End With
End Sub