PDA

View Full Version : [SOLVED] "mypath" causing a problem in a network drive



Beatrix
02-13-2014, 12:04 PM
Hi All ,

I have scripts in one workbook in parent folder to run the files in subfolders. I use c:\vba\ as mypath for testing and all codes work fine however when I change the path to the original one which is a network drive one of the codes doesn't open the file in the subfolder. But it doesn't give an error either. It does nothing. Apart from this code the other scripts work just fine in both C drive and K drive but only one script didn't like the network drive:doh:

Does anyone have any idea what would cause this issue?:think:

Cheers
B.

Kenneth Hobs
02-13-2014, 12:12 PM
I have seen that issue on occasion. A reboot usually fixed it.

Be sure to check if the file exists before doing things with it. You can also consider using the UNC path instead.


Sub ken()
Dim s As String
s = "\\ken007\excel\t\test.xlsm"
If Dir(s) <> "" Then Workbooks.Open (s)
End Sub

Beatrix
02-13-2014, 12:23 PM
Many thanks for your reply Mr Hobs. What is the UNC path?

Kenneth Hobs
02-13-2014, 12:59 PM
UNC defined: http://en.wikipedia.org/wiki/Uniform_Naming_Convention#Uniform_Naming_Convention

mancubus
02-14-2014, 12:52 AM
i use below procedure to display drives in msgbox:


Sub List_Network_Drive_Mappings()

With CreateObject("WScript.Network").EnumNetworkDrives
nDrv = "Network Drive Mappings" & vbLf & vbLf
For i = 0 To .Count - 1 Step 2
nDrv = nDrv & .Item(i) & vbTab & "=" & vbTab & .Item(i + 1) & vbLf
Next
End With

MsgBox nDrv
End Sub

Beatrix
02-14-2014, 10:12 AM
Thanks for all replies. I tried UNC too but no luck :(

@Mr Hobs - thanks very much for the link for UNC, even I use google all day -at work at home- to search many different things, I sometimes forget about it like in this case. Sorry again.

Kenneth Hobs
02-14-2014, 10:20 AM
Did you try the Dir() method to see if the file exists?

Debug.print Dir("\\ken007\excel\t\test.xlsm")<>""
Debug.print Dir("x:\excel\t\test.xlsm")<>""

Beatrix
02-14-2014, 10:48 AM
there are 3 workbooks under the shared folder in network drive. I didn't try the Dir() method but the files are there. Do I need to test it? This below code works perfectly in C drive but it doesn't work in K drive even with UNC. I talked to helpdesk and got exact UNC not to make any mistakes but it didn't work. Other scripts run just fine in shared folder in the same network drive. I don't understand why this script doesn't like it. Do you think something might be wrong with the script but in that case it wouldn't work in C drive either so it's not the script it's the path :(



Sub CreateSummary()
'
' Macro to create summary table containing the _
Min, Max, And 3 Quartiles of selected ranges In _
each sheet In the workbook. The user Is requested To _
Input the first cell of the range For the _
calculations. In addition the value of the _
row at 'Z' (in column C) is entered in the _
table.

mypath = "C:\VBA\" ' change to suit
fName = Dir(mypath & "*.xls") ' change file extension to suit
Do While Len(fName) > 0
Set wb = Workbooks.Open(mypath & fName)

Dim rInp As Range, rOut As Range, rFnd As Range, rSrch As Range, rC As Range, rA As Range
Dim wsIn As Worksheet, wsSum As Worksheet
Dim lR As Long, lC As Long, lA As Long
Dim vOut As Variant
Const sZZZ As String = "Z" ' This is the value to indicate special row
Const iCCC As Integer = 3 'Column C where sZZZ is to be searched

' Check if Summary sheet exists, else create
On Error Resume Next 'in case it doesn't exist
Set wsSum = Sheets("Summary")
On Error GoTo 0 ' reset error behaviour
If wsSum Is Nothing Then ' sheet does not exist
Set wsSum = Sheets.Add(after:=Sheets(Sheets.Count))
wsSum.Name = "Summary"
End If
Set rOut = wsSum.Range("D2")

'for our output we will gather the data into an array _
Then print out a row at once For Each sheet. _
first the header:
ReDim vOut(1 To 1, 1 To 8)
vOut(1, 1) = "Sheet"
vOut(1, 2) = "Range"
vOut(1, 3) = "Z"
vOut(1, 4) = "Min"
vOut(1, 5) = "Q1"
vOut(1, 6) = "Q2"
vOut(1, 7) = "Q3"
vOut(1, 8) = "Max"
rOut.Resize(1, UBound(vOut, 2)).Value = vOut 'print headers to sheet
Set rOut = rOut.Offset(1, 0) ' set to next row

' Now go through each sheet, get user to enter _
range For processing. Then calculate quartiles _
And add the Z figure.

For Each wsIn In Sheets
If wsIn.Name <> wsSum.Name Then
GetRange:
wsIn.Activate
On Error GoTo CleanUp
Set rInp = Application.InputBox( _
prompt:="Please select 1st cell of each range in this sheet " _
& vbCrLf & "to be processed for Quartiles (to use the whole column)" & vbCrLf _
& "You can use your mouse and Ctrl key to select.", _
Title:="Select Quartiles Range", _
Type:=8)
On Error GoTo 0
If rInp Is Nothing Then GoTo GetRange ' loop if invalid input
If rInp.Parent.Name <> wsIn.Name Then GoTo GetRange ' loop if selection is on wrong sheet

For lA = 1 To rInp.Areas.Count ' count areas in the input range: non-contiguous areas
Set rA = rInp.Areas(lA)
For lC = 1 To rA.Columns.Count ' check for multiple columns in each contiguous area
Set rC = rA(1, lC) ' use the first cell of each column and extend it vertically
' extend range to end of sheet
lR = wsIn.Cells(Rows.Count, rC.Column).End(xlUp).Row ' last row, now skip summary if exists
If wsIn.Cells(lR, rC.Column).Offset(-1, 0) = vbNullString Then ' there is a summary line,
lR = wsIn.Cells(lR, rC.Column).End(xlUp).Row 'exclude it
End If
Set rC = rC.Cells(1, 1).Resize(lR - rC.Row + 1, 1)
' calculate quartiles from provided range
With Application.WorksheetFunction
vOut(1, 1) = wsIn.Name
vOut(1, 2) = "Column " & Left(rC.Address(1, 0), InStr(1, rC.Address(1, 0), "$") - 1)
vOut(1, 4) = .Min(rC)
vOut(1, 5) = .quartile(rC, 1)
vOut(1, 6) = .quartile(rC, 2)
vOut(1, 7) = .quartile(rC, 3)
vOut(1, 8) = .Max(rC)
End With
'find the 'Z'
Set rSrch = wsIn.Cells
Set rFnd = rSrch.Find(what:=sZZZ, after:=Cells(rC.Row - 1, 3), _
lookat:=xlWhole, LookIn:=xlValues, _
searchdirection:=xlNext)
If rFnd Is Nothing Then ' not found
vOut(1, 3) = vbNullString
Else ' get value at intersection of column and row
vOut(1, 3) = Intersect(rC, wsIn.Rows(rFnd.Row)).Value
End If
rOut.Resize(1, UBound(vOut, 2)).Value = vOut 'print values to sheet
Set rOut = rOut.Offset(1, 0) ' set to next row
Next lC
Next lA

End If
Next wsIn

'format table
Set rOut = rOut.Offset(-1, 0).CurrentRegion
FormatSumTbl rOut
wsSum.Activate

CleanUp:
Set wsIn = Nothing
Set wsSum = Nothing
Set rOut = Nothing
Set rInp = Nothing
Set rFnd = Nothing
Set rSrch = Nothing

wb.Close True ' to save or false to close without saving
fName = Dir ' get next filename
Loop

End Sub




Sub FormatSumTbl(rTbl As Range)
'
' FormatSumTbl Macro
' Format the Summary Table & headings
'


'
With rTbl
.HorizontalAlignment = xlCenter
.NumberFormat = "0.0"
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Columns(1)
.Borders(xlInsideHorizontal).LineStyle = xlNone
.EntireColumn.AutoFit
With .Font
.Color = -16776961
.TintAndShade = 0
End With
End With
With .Columns(2)
.Borders(xlInsideHorizontal).LineStyle = xlNone
.EntireColumn.AutoFit
With .Font
.Color = -16776961
.TintAndShade = 0
End With
End With
With .Rows(1)
.Font.Underline = xlUnderlineStyleSingle
End With
With .Columns(3)
.Font.Bold = True
.Font.Underline = xlNone
End With
With Cells(1, 2).Font
.Color = -16776961
.TintAndShade = 0
End With
End With
End Sub

Kenneth Hobs
02-14-2014, 11:14 AM
If the DIR() methods says the file does not exist, then that is your problem. Get the path right or check user access rights.

Beatrix
02-14-2014, 11:41 AM
I can't believe myself:crying: Because some files are xls some are xlsx and below code includes only .xls It worked when I changed it as xlsx. How can I include both file types? by using "," or "OR" function?


mypath = "C:\VBA\" ' change to suit
fName = Dir(mypath & "*.xls") ' change file extension to suit
Do While Len(fName) > 0
Set wb = Workbooks.Open(mypath & fName)

Kenneth Hobs
02-14-2014, 11:54 AM
fName = Dir(mypath & "*.xls?")You may still need a check to check file extension as you may not want xlsm or such. I would use an FSO method if I wanted to check file extensions.

Beatrix
02-23-2014, 05:14 PM
Thanks Mr Hobs. I read more about the FSO.

http://www.exceltrick.com/formulas_macros/filesystemobject-in-vba/