Hi People,

Is there a way (function) to display the name of the file, from which
you have imported data into your sheet, in a cell of that sheet.

The data is imported using Data - Import External Data - .....

All help will be much appreciated


--
coa01gsb
------------------------------------------------------------------------
coa01gsb's Profile: http://www.excelforum.com/member.php...o&userid=31214
View this thread: http://www.excelforum.com/showthread...hreadid=524718

A simple procedure, assuming you are in the same Worksheet as the imported
table and your cusor is where you want to put the filename...

Public Sub QueryConnection1()
ActiveCell.Value = ActiveSheet.QueryTables(1).Connection
End Sub

HTH,
--
Gary Brown

If this post was helpful, please click the ''Yes'' button next to ''Was this
Post Helpfull to you?''.


"coa01gsb" wrote:


Hi People,

Is there a way (function) to display the name of the file, from which
you have imported data into your sheet, in a cell of that sheet.

The data is imported using Data - Import External Data - .....

All help will be much appreciated


--
coa01gsb
------------------------------------------------------------------------
coa01gsb's Profile: http://www.excelforum.com/member.php...o&userid=31214
View this thread: http://www.excelforum.com/showthread...hreadid=524718

A much more elaborate procedure that gives more information and has a lot of
error handling, etc is the procedure below "QueriesList" which is the main
procedure you would call. I don't believe there is any 'wrapping' of code
lines but keep there may be.

'MACRO STARTS HERE
'/============================================/
Option Explicit

'Public iDriveType As Integer
Public strNetwork As String

'/============================================/
Sub QueriesList()
On Error Resume Next
'Purpose of this VBA program is to find and list all Queries
'in a Workbook
' For use with EXCEL 97 or higher
' written by Gary L. Brown
'
Dim iRow As Long, iColumn As Long, dblLastRow
Dim i As Integer
Dim x As Integer, iWorksheets As Integer
Dim objOutputArea As Object
Dim qryTable As QueryTable
Dim strQueryParameters As String
Dim strRngAddress As String
Dim strResultsTableName As String
Dim strOrigCalcStatus As String
Dim wksWorksheet As Worksheet

'/- - Initialize various Variables - -/
strResultsTableName = "Queries_Table"
strQueryParameters = ""
strRngAddress = ""
x = 0
'/- - - - - - - - - - - - - - - - - -/

'save calculation setting
Select Case Application.Calculation
Case xlCalculationAutomatic
strOrigCalcStatus = "Automatic"
Case xlCalculationManual
strOrigCalcStatus = "Manual"
Case xlCalculationSemiautomatic
strOrigCalcStatus = "SemiAutomatic"
Case Else
strOrigCalcStatus = "Automatic"
End Select

'set workbook to manual
Application.Calculation = xlManual

'check to see if there are any MS Queries in active workbook
For Each wksWorksheet In ActiveWorkbook.Worksheets
For Each qryTable In wksWorksheet.QueryTables
If wksWorksheet.QueryTables.Count 0 Then
x = 1
Exit For
End If
Next qryTable
If x = 1 Then
Exit For
End If
Next wksWorksheet

If x = 1 Then 'proceed if there are active MS Queries in Wkbk
'Check for duplicate Worksheet name
i = ActiveWorkbook.Sheets.Count
For x = 1 To i
If Windows.Count = 0 Then Exit Sub
If UCase(Worksheets(x).name) = _
UCase(strResultsTableName) Then
Worksheets(x).Activate
If Err.Number = 9 Then
Exit For
End If
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
'Exit Sub
End If
Next

'Add new worksheet at end of workbook
' where results will be located
Worksheets.Add.Move After:=Worksheets(Worksheets.Count)

'Name the new worksheet and set up Titles
ActiveWorkbook.ActiveSheet.name = strResultsTableName
ActiveWorkbook.ActiveSheet.Range("A1").value = _
"Worksheet/Range"
ActiveWorkbook.ActiveSheet.Range("B1").value = "Query Name"
ActiveWorkbook.ActiveSheet.Range("C1").value = "Connection"
ActiveWorkbook.ActiveSheet.Range("D1").value = "Parameters"
ActiveWorkbook.ActiveSheet.Range("E1").value = "SQL"

'Count number of worksheets in workbook
iWorksheets = ActiveWorkbook.Sheets.Count

'Initialize row and column counts for putting info into
' strResultsTableName sheet
iRow = 1
iColumn = 0

Set objOutputArea = _
ActiveWorkbook.Sheets(strResultsTableName).Range(" A1")

'evaluate all queries in the workbook
If Windows.Count = 0 Then
Exit Sub
End If
For Each wksWorksheet In ActiveWorkbook.Worksheets
For Each qryTable In wksWorksheet.QueryTables
With objOutputArea
'put information into strResultsTableName worksheet
strRngAddress = _
FindQueryRange(qryTable.name, wksWorksheet.name)
If Len(strRngAddress) 0 Then
'Syntax is different for local vs. network drives
If strNetwork = "LOCAL" Then
.Hyperlinks.Add Anchor:=.Offset(iRow, iColumn), _
Address:="", _
SubAddress:=wksWorksheet.name & "!" & _
ChangeQueryNameToRangeName(qryTable.name), _
TextToDisplay:=Chr(39) & " " & _
Right(strRngAddress, Len(strRngAddress) - 1)
Else
.Hyperlinks.Add Anchor:=.Offset(iRow, iColumn), _
Address:="", SubAddress:=Chr(39) & _
wksWorksheet.name & Chr(39) & "!" & _
ChangeQueryNameToRangeName(qryTable.name), _
TextToDisplay:=Chr(39) & " " & _
Right(strRngAddress, Len(strRngAddress) - 1)
End If
End If
.Offset(iRow, iColumn + 1) = " " & qryTable.name
.Offset(iRow, iColumn + 2) = qryTable.Connection
strQueryParameters = "# of Parameters: " & _
qryTable.Parameters.Count
If qryTable.Parameters.Count 0 Then
strQueryParameters = strQueryParameters & vbLf & _
" Parameters: "
For x = 1 To qryTable.Parameters.Count
strQueryParameters = _
strQueryParameters & vbLf & " - " & _
qryTable.Parameters(x).PromptString
Next x
End If
.Offset(iRow, iColumn + 3) = " " & strQueryParameters
.Offset(iRow, iColumn + 4) = qryTable.Sql
iRow = iRow + 1
End With
Next qryTable
Next wksWorksheet

'Release all variables from memory
Set objOutputArea = Nothing

'formatting output
Columns("A:E").Select
With Selection
.WrapText = False
End With

Columns("A:E").EntireColumn.AutoFit

Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.WrapText = True
End With
With Selection.Font
.Underline = xlUnderlineStyleSingleAccounting
End With
Range("A2").Select
ActiveWindow.FreezePanes = True

Columns("A:A").Select
If Selection.ColumnWidth 50 Then
Selection.ColumnWidth = 50
End If
With Selection
.WrapText = True
End With

Columns("B:B").Select
If Selection.ColumnWidth 50 Then
Selection.ColumnWidth = 50
End If
With Selection
.WrapText = True
End With

Columns("C:C").Select
If Selection.ColumnWidth 50 Then
Selection.ColumnWidth = 50
End If
With Selection
.WrapText = True
.EntireColumn.AutoFit
End With

Columns("D:D").Select
If Selection.ColumnWidth 50 Then
Selection.ColumnWidth = 50
End If
With Selection
.WrapText = True
.EntireColumn.AutoFit
End With

Columns("E:E").Select
If Selection.ColumnWidth 75 Then
Selection.ColumnWidth = 75
End If
With Selection
.WrapText = True
End With

Cells.Select
With Selection
.EntireRow.AutoFit
.VerticalAlignment = xlTop
End With

Range("A1").Select

'formatting printing
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
End With
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.25)
.FooterMargin = Application.InchesToPoints(0.25)
.Orientation = xlLandscape
.Order = xlOverThenDown
.Zoom = 80
.LeftHeader = "&""Tms Rmn,Bold""&U&A"
.LeftFooter = "Printed: &D - &T"
.CenterFooter = "Page &P of &N"
.RightFooter = "&F-&A"
.PrintGridlines = True
.FitToPagesWide = 1
.FitToPagesTall = False
End With

ActiveWindow.Zoom = 75
Else
MsgBox "There are no MS Queries in this Workbook." & _
vbCr & vbCr & "Query Listing ended.", _
vbInformation + vbOKOnly, "No MS Queries found..."
End If

're-set to original calculation method
Select Case strOrigCalcStatus
Case "Automatic"
Application.Calculation = xlCalculationAutomatic
Case "Manual"
Application.Calculation = xlCalculationManual
Case "SemiAutomatic"
Application.Calculation = xlCalculationSemiautomatic
Case Else
Application.Calculation = xlCalculationAutomatic
End Select

Application.Dialogs(xlDialogWorkbookName).Show

End Sub
'/============================================/
Private Function FindQueryRange(strQueryName As String, _
strWorksheetName As String) As String
Dim nRangeName As name
Dim strRangeAddress As String
Dim strRangeName As String

'initialize
FindQueryRange = ""
strNetwork = ""
strRangeAddress = ""
strRangeName = ""


'step 1 is to make the Query name correspond to the
' range name because query names can use all sorts
' of special characters while range names can only
' use a limited range of characters.
' The rest of the special characters are translated to an
' underscore "_".
'
strRangeName = ChangeQueryNameToRangeName(strQueryName)

'step 2 is to find the range name to get the range address
' - single quotation (')/Chr(39) syntax is used
' for network addresses
strRangeName = Chr(39) & strWorksheetName & Chr(39) & "!" & _
strRangeName


'check for network address - if local string will be empty
For Each nRangeName In ActiveWorkbook.Names
If nRangeName.name = strRangeName Then
strRangeAddress = nRangeName.RefersTo
Exit For
End If
Next nRangeName

'if the string came back empty
' then the address is from a local drive
If Len(strRangeAddress) = 0 Then
strRangeName = ChangeQueryNameToRangeName(strQueryName)
strRangeName = strWorksheetName & "!" & strRangeName
For Each nRangeName In ActiveWorkbook.Names
If nRangeName.name = strRangeName Then
strRangeAddress = nRangeName.RefersTo
Exit For
End If
Next nRangeName
strNetwork = "LOCAL"
End If

FindQueryRange = strRangeAddress

End Function
'/============================================/
Private Function ChangeQueryNameToRangeName(strQueryName1)
Dim i As Integer, x As Integer
Dim strRngName As String

strRngName = ""

i = Len(strQueryName1)

For x = 1 To i
'check for: 0-9, A-Z, a-z, . , ? , _ , \
'Range names can ONLY include these characters.
' All others are changed to an underscore "_"
If Not ((Asc(Mid(strQueryName1, x, 1)) = 48 And _
Asc(Mid(strQueryName1, x, 1)) <= 57) _
Or (Asc(Mid(strQueryName1, x, 1)) = 65 And _
Asc(Mid(strQueryName1, x, 1)) <= 90) _
Or (Asc(Mid(strQueryName1, x, 1)) = 97 And _
Asc(Mid(strQueryName1, x, 1)) <= 122) _
Or (Asc(Mid(strQueryName1, x, 1)) = 46) _
Or (Asc(Mid(strQueryName1, x, 1)) = 63) _
Or (Asc(Mid(strQueryName1, x, 1)) = 92) _
Or (Asc(Mid(strQueryName1, x, 1)) = 95)) Then
strRngName = strRngName & "_"
Else
strRngName = strRngName & Mid(strQueryName1, x, 1)
End If
Next x

ChangeQueryNameToRangeName = strRngName

End Function
'/============================================/
Private Function BreakoutConnectionData(strConnection As _
String) As String
Dim strInfo As String

' On Error GoTo exit_Function
On Error Resume Next

BreakoutConnectionData = strConnection

BreakoutConnectionData = "Connection Source: " & _
Left(strConnection, Application.WorksheetFunction.Find(";", _
strConnection)) & _
vbLf
BreakoutConnectionData = BreakoutConnectionData & _
"Data Source Name: " & Mid(strConnection, _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 1)) + 1, _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 2)) - _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 1))) & _
vbLf
BreakoutConnectionData = BreakoutConnectionData & _
"Query Source: " & Mid(strConnection, _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 2)) + 1, _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 3)) - _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 2))) & _
vbLf
BreakoutConnectionData = _
BreakoutConnectionData & "Default Directory: " & _
Mid(strConnection, WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 3)) + 1, _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 4)) - _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 3))) & _
vbLf
BreakoutConnectionData = BreakoutConnectionData & _
"Driver ID: " & Mid(strConnection, _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 4)) + 1, _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 5)) - _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 4))) & _
vbLf
BreakoutConnectionData = BreakoutConnectionData & _
"File Type: " & Mid(strConnection, _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 5)) + 1, _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 6)) - _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 5))) & _
vbLf
BreakoutConnectionData = BreakoutConnectionData & _
Mid(strConnection, _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 6)) + 1, _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 7)) - _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 6))) & _
vbLf
BreakoutConnectionData = BreakoutConnectionData & _
Mid(strConnection, _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 7)) + 1, _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 8)) - _
WorksheetFunction.Find("~", _
WorksheetFunction.Substitute(strConnection, ";", "~", 7)))

exit_Function:


End Function
'/============================================/
'MACRO ENDS HERE


hth,
--
Gary Brown

If this post was helpful, please click the ''Yes'' button next to ''Was this
Post Helpfull to you?''.


"Gary L Brown" wrote:

A simple procedure, assuming you are in the same Worksheet as the imported
table and your cusor is where you want to put the filename...

Public Sub QueryConnection1()
ActiveCell.Value = ActiveSheet.QueryTables(1).Connection
End Sub

HTH,
--
Gary Brown

If this post was helpful, please click the ''Yes'' button next to ''Was this
Post Helpfull to you?''.


"coa01gsb" wrote:


Hi People,

Is there a way (function) to display the name of the file, from which
you have imported data into your sheet, in a cell of that sheet.

The data is imported using Data - Import External Data - .....

All help will be much appreciated


--
coa01gsb
------------------------------------------------------------------------
coa01gsb's Profile: http://www.excelforum.com/member.php...o&userid=31214
View this thread: http://www.excelforum.com/showthread...hreadid=524718