• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 486
  • Last Modified:

Import macro with user connection selection

Hi Experts,
I have the following macro below that imports data from a usb stick.
As you can see it gets the data from E:\1_attlog.dat.
The problem I have is that on my users computers there usb stick they plug in may be another drive other than E drive like on my computer.
What I was thinking is that on sheet "FP Reader" F6 they have to enter the drive letter that there memory stick use's. Then the code below choses the drive letter from F6.
Is this possible???

Cheers

Rob.

Sub Macro1()
'
With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;E:\1_attlog.dat", Destination:=Range("$B$5"))
        .Name = "1_attlog_2"
        .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 = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Columns("B:B").Select
    Selection.ColumnWidth = 6
    Range("I2").Select
End Sub
0
RobJanine
Asked:
RobJanine
  • 6
  • 5
2 Solutions
 
dlmilleCommented:
Something like this?
Sub Macro1()
Dim fPath As String

fPath = Sheets("FP Reader").Range("F6").Value & ":\1_attlog.dat" 'drive letter input on F6 range of FP Reader sheet

With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & fPath, Destination:=Range("$B$5"))
        .Name = "1_attlog_2"
        .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 = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Columns("B:B").Select
    Selection.ColumnWidth = 6
    Range("I2").Select
End Sub

Open in new window

Dave
0
 
RobJanineAuthor Commented:
Works great thanks, If there is no drive of the letter chosen can it bring up an error message that I chose??

Cheers
0
 
ScriptAddictCommented:
sure just add
this before fpath
on error goto ErrorMsg


'then put this at the very end of the code before end sub
exit sub
ErrorMsg:
Msgbox "The file is unavailable for import"

Open in new window

0
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
dlmilleCommented:
Without getting too fancy, you could just prompt for it, rather than flagging an error - though having an error handler would be a good thing, as well...

Something like:
 
Sub Macro1()
Dim fPath As String
Dim getDrv As String
Dim alpha As String


If Sheets("FP Reader").Range("F6").Value = "" Then
    getDrv = InputBox("Enter Drive Letter for Query", Default:="F:")
    Sheets("FP Reader").Range("F6").Value = getDrv
End If

fPath = Sheets("FP Reader").Range("F6").Value & ":\1_attlog.dat" 'drive letter input on F6 range of FP Reader sheet

With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & fPath, Destination:=Range("$B$5"))
        .Name = "1_attlog_2"
        .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 = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Columns("B:B").Select
    Selection.ColumnWidth = 6
    Range("I2").Select
End Sub

Open in new window


Dave
0
 
dlmilleCommented:
change line 8 to

getDrv = InputBox("Enter Drive Letter for Query",Default:="F")

sorry - getting sloppy, today
0
 
RobJanineAuthor Commented:
thanks for your replies, just had a thought....can it look for the file ":\1_attlog.dat" on open drives, or usb drives? I am just looking for the easiest way to look up this file that a user plugs a pen drive into. the file name is allways the same. I also have about 10 different people using this programe, some dont know much at all about computers let alone drive letters etc.

Cheers
0
 
dlmilleCommented:
Are you saying you want it to look for this file on any available drives the PC might be attached to?

That should be doable - there should be a call we can make that will help enumerate existing drive letters...

PS - please share credit with ScriptAddict - he was responsive to your question, this AM as I was out of pocket - and his idea on having an error trap is a good one!

Dave
0
 
RobJanineAuthor Commented:
yes, any deive attached to there laptop or pc.
Yes I will share some credit as above.
sorry for only thinking of this now, but if it can be done I think it would work best.

Thanks

Rob
0
 
dlmilleCommented:
ok - we'll look at available drives and the first drive that has that file in the root directory will be the one to go with, otherwise a message, correct?

No need to look at F6 range, anymore, right?

Dave
0
 
RobJanineAuthor Commented:
available drives yes, but every time they click my import macro, and tes no need for F6 range anymore.
I am excited if this can work, didnt realize how much you can do.

Cheers
Rob.
0
 
dlmilleCommented:
I used a couple online sources: http://excelexperts.com/List-and-Type-of-Drives-VBA - to get drive letters for "ready" drives

and Ken Puls (www.excelguru.ca) - for the fileFolderExists function I use all the time.

From this, I wrote a couple utility functions that help determine where the file might exists, iterating through all ready drives.

Here's the primary code:
 
Sub getData()
Dim fPath As String
Dim fName As String
Dim getDrv As String
Dim alpha As String

    fName = "1_attlog.dat" 'put full path without drive letter here.  if in root, just put filename
    
    fPath = getFilePathAnyDrive(fName)
    If fPath = "" Then
        MsgBox "No drive was found containing the file: " & fName, vbCritical, "Aborting!"
    Else
        Application.StatusBar = "File: " & fPath & " found...  Processing..."
        
        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & fPath, Destination:=Range("$B$5"))
            .Name = "1_attlog_2"
            .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 = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        Columns("B:B").Select
        Selection.ColumnWidth = 6
        Range("I2").Select
        Application.StatusBar = False
    End If
End Sub

Open in new window

And here's the support code:
 
'Source: http://excelexperts.com/List-and-Type-of-Drives-VBA
Option Explicit
Sub DriveTypeAndList()
    Dim objDrv      As Object
    Dim strMsg      As String
 
    For Each objDrv In CreateObject("Scripting.FileSystemObject").Drives
        Select Case objDrv.DriveType
            Case 0: strMsg = strMsg & vbNewLine & objDrv.driveletter & ": Unknown"
            Case 1: strMsg = strMsg & vbNewLine & objDrv.driveletter & ": Removable Drive"
            Case 2: strMsg = strMsg & vbNewLine & objDrv.driveletter & ": Hard Disk Drive"
            Case 3: strMsg = strMsg & vbNewLine & objDrv.driveletter & ": Network Drive"
            Case 4: strMsg = strMsg & vbNewLine & objDrv.driveletter & ": CDROM Drive"
            Case 5: strMsg = strMsg & vbNewLine & objDrv.driveletter & ": RAM Disk Drive"
        End Select
    Next
 
    Set objDrv = Nothing
    MsgBox strMsg, vbInformation, "Excel Experts Tip"
End Sub
Public Function FileFolderExists(strFullPath As String) As Boolean
'Author       : Ken Puls (www.excelguru.ca)
'Macro Purpose: Check if a file or folder exists

    On Error GoTo EarlyExit
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
    
EarlyExit:
    On Error GoTo 0

End Function
Public Function getDriveList() As Collection
Dim objDrv As Object

    Set getDriveList = New Collection
    For Each objDrv In CreateObject("Scripting.FileSystemObject").Drives
        If objDrv.isready Then getDriveList.Add objDrv.driveletter
    Next objDrv
    
    Set objDrv = Nothing
    
End Function
Public Function getFilePathAnyDrive(fName As String) As Variant
Dim objDrv As Variant

    For Each objDrv In getDriveList
        If FileFolderExists(objDrv & ":\" & fName) Then
            getFilePathAnyDrive = objDrv & ":\" & fName
            Exit For
        End If
    Next objDrv
    
End Function

Open in new window


See attached file - the code gets pasted into public modules, as you'll see when you hit ALT-F11 to see the VBE Editor.

Cheers,

Dave
getPathForQuery-r1.xls
0
 
RobJanineAuthor Commented:
WOW, Thanks so much, works perfectly.
Cheers

Rob
0

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

  • 6
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now