First of all I'm not an expert. I've been colelcting bits and peaces of VBA/VBS code and tried to get it work and it did to a point.
I'm trying to map network drive and select file txt file to import, disconnect the drive and select another one (assign same letter Q and import another txt file. All together I have to import some 10-15 txt files from 10-15 different network locations. My problem is that after first network drive is mapped, my "Open File to Import" dialog box is not refreshing with new drive.
Please help!
Sub MapDrive()
frmMain.Show
Dim FileToOpen As String
Dim MyDrive As Object
Dim MyDriveName As String
MsgBox ("MyDriveName:" & MyDriveName)
MsgBox ("FileToOpen:" & FileToOpen)
MyDriveName = VGageIP
MsgBox ("MyDriveName:" & MyDriveName)
'------------------------------------------------------------
'- map drive
On Error Resume Next ' DRIVE MAY BE MAPPED ALREADY
Set MyDrive = CreateObject("WScript.Network")
MyDrive.MapNetworkDrive "Q:", MyDriveName
DoEvents
'--------------------------------------------------------------
'- error check
If Err.Number <> 0 Then
MsgBox (" Drive already mapped or not available ")
Else
MsgBox ("Q Drive Mapped OK")
End If
ChDrive "C:\"
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a file to import", _
FileFilter:="Text Files *.txt (*.txt),")
MsgBox ("FileToOpen:" & FileToOpen)
Application.WindowState = xlMinimized
Sheets("DATA").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & FileToOpen & "", Destination:=Range( _
"A1"))
.Name = "DATA"
.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 = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileOtherDelimiter = ""
.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)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Application.WindowState = xlMaximized
ChDrive "C:\"
'RemoveWs 'Remove Q Drive
'Option Explicit
Dim objShell, objNetwork, DriveLetter1
DriveLetter1 = "Q:"
Set objShell = CreateObject("WScript.Shell")
Set objNetwork = CreateObject("WScript.Network")
objNetwork.RemoveNetworkDrive DriveLetter1
objShell.PopUp "Drive " & DriveLetter1 & " disconnected."
'Clear variables
MyDriveName = ""
VGageIP = ""
DriveLetter1 = ""
FileToOpen = ""
'MyDrive.RemoveNetworkDrive "Q:", bForce:=True
'MsgBox "Q Drive Removed"
MsgBox ("FileToOpen:" & FileToOpen)
MsgBox ("VGageIP:" & VGageIP)
Wscript.Quit
I'm trying to map network drive and select file txt file to import, disconnect the drive and select another one (assign same letter Q and import another txt file. All together I have to import some 10-15 txt files from 10-15 different network locations. My problem is that after first network drive is mapped, my "Open File to Import" dialog box is not refreshing with new drive.
Please help!
Sub MapDrive()
frmMain.Show
Dim FileToOpen As String
Dim MyDrive As Object
Dim MyDriveName As String
MsgBox ("MyDriveName:" & MyDriveName)
MsgBox ("FileToOpen:" & FileToOpen)
MyDriveName = VGageIP
MsgBox ("MyDriveName:" & MyDriveName)
'------------------------------------------------------------
'- map drive
On Error Resume Next ' DRIVE MAY BE MAPPED ALREADY
Set MyDrive = CreateObject("WScript.Network")
MyDrive.MapNetworkDrive "Q:", MyDriveName
DoEvents
'--------------------------------------------------------------
'- error check
If Err.Number <> 0 Then
MsgBox (" Drive already mapped or not available ")
Else
MsgBox ("Q Drive Mapped OK")
End If
ChDrive "C:\"
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a file to import", _
FileFilter:="Text Files *.txt (*.txt),")
MsgBox ("FileToOpen:" & FileToOpen)
Application.WindowState = xlMinimized
Sheets("DATA").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & FileToOpen & "", Destination:=Range( _
"A1"))
.Name = "DATA"
.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 = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileOtherDelimiter = ""
.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)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Application.WindowState = xlMaximized
ChDrive "C:\"
'RemoveWs 'Remove Q Drive
'Option Explicit
Dim objShell, objNetwork, DriveLetter1
DriveLetter1 = "Q:"
Set objShell = CreateObject("WScript.Shell")
Set objNetwork = CreateObject("WScript.Network")
objNetwork.RemoveNetworkDrive DriveLetter1
objShell.PopUp "Drive " & DriveLetter1 & " disconnected."
'Clear variables
MyDriveName = ""
VGageIP = ""
DriveLetter1 = ""
FileToOpen = ""
'MyDrive.RemoveNetworkDrive "Q:", bForce:=True
'MsgBox "Q Drive Removed"
MsgBox ("FileToOpen:" & FileToOpen)
MsgBox ("VGageIP:" & VGageIP)
Wscript.Quit