# VBA code to map a drive



## gmoukled (Oct 17, 2011)

I am currently using the code below, to import a csv file from a drive.

I am mapping the drive manually before running the macro.

What I would like to do is to add some line of code to my existing macro to make it map the drive automatically ( the drive has credentials too) 

```
Sub RunAll()


Dim ImportFilePath As String, ExportFilePath As String
Dim File2Import As String, File2Export As String
ImportFilePath = "\\[COLOR="Red"]DRIVE NAME[/COLOR]\c$\UPS32"
ExportFilePath = "C:\Users\TZFTQF\Fall 2011 Coop term\Server Cycle Time\Template"
File2Import = "copy_2_server_cycle_time.csv"
File2Export = "Template"
Call Macro1(ImportFilePath, File2Import, ExportFilePath, File2Export)
Call Macro2(ImportFilePath, File2Import, ExportFilePath, File2Export)



 ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\TZFTQF\Fall 2011 Coop term\Server Cycle Time\SpreadSheet.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub

Sub Macro1(ImportFilePath, File2Import, ExportFilePath, File2Export)
'
' Macro1 Macro
'

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;\\[COLOR="red"]DRIVE NAME[/COLOR]\c$\UPS32\copy_2_server_cycle_time.csv" _
        , Destination:=Range("$A$1"))
        .Name = "copy_2_server_cycle_time"
        .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 = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Cells.Select
    ActiveWorkbook.Worksheets("RAW DATA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RAW DATA").Sort.SortFields.Add Key:=Columns( _
        "D:D"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("RAW DATA").Sort.SortFields.Add Key:=Columns( _
        "A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("RAW DATA").Sort.SortFields.Add Key:=Columns( _
        "E:E"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("RAW DATA").Sort
        .SetRange Range("A1:E99999")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Dim rngFind As Range
    Dim strValueToPick As String
    Dim rngPicked As Range
    Dim rngLook As Range
    Dim strFirstAddress As String
    
    Set rngLook = Selection
    strValueToPick = "COLDTEST1"
    With rngLook
        Set rngFind = .Find(strValueToPick, .Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole)
        If Not rngFind Is Nothing Then
            strFirstAddress = rngFind.Address
            Set rngPicked = rngFind
            Do
                Set rngPicked = Union(rngPicked, rngFind)
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
        End If
    End With
    
    If Not rngPicked Is Nothing Then
        rngPicked.Offset(0, 1).Select
        
        Selection.Copy
        Sheets("COLDTEST1 CHART").Activate
        Range("$A$1").Select
        Selection.PasteSpecial
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.ChartType = xlXYScatter
        ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
        ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Time"
        ActiveChart.Legend.Select
        Selection.Delete
        ActiveSheet.Shapes("Chart 1").ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
        ActiveSheet.Shapes("Chart 1").ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
    End If
    
End Sub
```
I was originally using this code to import the csv file from my desktop. All i did is that i replaced the file path with the drive name. But i am mapping the drive manually before running the macro!

Your help is appreciated!


----------



## Rollin_Again (Sep 4, 2003)

This should do the trick. Just change the drive letter, path, username, and password which are highlighted in red below.


```
Dim objNetwork As Object
Set objNetwork = CreateObject("WScript.Network")
objNetwork.MapNetworkDrive "[COLOR="Red"]F[/COLOR]:", "[COLOR="Red"]\\DRIVE NAME\c$\UPS32[/COLOR]", False, "[COLOR="Red"]username[/COLOR]", "[COLOR="Red"]password[/COLOR]"
```
Rollin


----------



## gmoukled (Oct 17, 2011)

Thanks Rollin

I tried to add your code to my existing code as follows:

```
Sub RunAll()


   [COLOR="Red"] Dim objNetwork As Object
Set objNetwork = CreateObject("WScript.Network")
objNetwork.MapNetworkDrive "C:", "\\DRIVE NAME\c$\UPS32", False, "gm", "gm"[/COLOR]


Dim ImportFilePath As String, ExportFilePath As String
Dim File2Import As String, File2Export As String
[COLOR="red"]ImportFilePath = "\\DRIVE NAME\c$\UPS32"[/COLOR]
ExportFilePath = "C:\Users\TZFTQF\Fall 2011 Coop term\Server Cycle Time\Template"
File2Import = "copy_2_server_cycle_time.csv"
File2Export = "Template"
Call Macro1(ImportFilePath, File2Import, ExportFilePath, File2Export)
Call Macro2(ImportFilePath, File2Import, ExportFilePath, File2Export)



 ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\TZFTQF\Fall 2011 Coop term\Server Cycle Time\SpreadSheet.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub

Sub Macro1(ImportFilePath, File2Import, ExportFilePath, File2Export)
'
' Macro1 Macro
'

'
    With ActiveSheet.QueryTables.Add(Connection:= _
      [COLOR="red"]  "TEXT;\\CASCFSA0CLD01\c$\UPS32\copy_2_server_cycle_time.csv" _[/COLOR]
        , Destination:=Range("$A$1"))
        .Name = "copy_2_server_cycle_time"
        .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 = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Cells.Select
    ActiveWorkbook.Worksheets("RAW DATA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RAW DATA").Sort.SortFields.Add Key:=Columns( _
        "D:D"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("RAW DATA").Sort.SortFields.Add Key:=Columns( _
        "A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("RAW DATA").Sort.SortFields.Add Key:=Columns( _
        "E:E"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("RAW DATA").Sort
        .SetRange Range("A1:E99999")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Dim rngFind As Range
    Dim strValueToPick As String
    Dim rngPicked As Range
    Dim rngLook As Range
    Dim strFirstAddress As String
    
    Set rngLook = Selection
    strValueToPick = "COLDTEST1"
    With rngLook
        Set rngFind = .Find(strValueToPick, .Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole)
        If Not rngFind Is Nothing Then
            strFirstAddress = rngFind.Address
            Set rngPicked = rngFind
            Do
                Set rngPicked = Union(rngPicked, rngFind)
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
        End If
    End With
    
    If Not rngPicked Is Nothing Then
        rngPicked.Offset(0, 1).Select
        
        Selection.Copy
        Sheets("COLDTEST1 CHART").Activate
        Range("$A$1").Select
        Selection.PasteSpecial
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.ChartType = xlXYScatter
        ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
        ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Time"
        ActiveChart.Legend.Select
        Selection.Delete
        ActiveSheet.Shapes("Chart 1").ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
        ActiveSheet.Shapes("Chart 1").ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
    End If
    
End Sub
```
The changes I made are in red.
I am getting the error : '-2147024811(80070055)'
The local device name is already in use.


----------



## Rollin_Again (Sep 4, 2003)

You are trying to use *C:* as the mapped drive letter and it is already being used since this is where the operating system files are located. You'll have to pick a different drive letter to use.

Rollin


----------



## gmoukled (Oct 17, 2011)

OK, that worked fine. However, when i tried to run my program a second time, I got the same error. I changed the drive letter again and it worked. It seems that i would need to change the letter each time i want to run the program! 

How do I fix that?


----------



## gmoukled (Oct 17, 2011)

I am thinking i might need to unmap the drive, i tried to add this

```
MyDrive.RemoveNetworkDrive "Drive Letter:", bForce:=True
```
 but whenever i run the code it just crashes.


----------



## Rollin_Again (Sep 4, 2003)

You need to check to see if the drive is mapped first or add error handling to accommodate for the error.

Rollin


----------



## gmoukled (Oct 17, 2011)

How do i do that?


----------

