View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
ker_01 ker_01 is offline
external usenet poster
 
Posts: 395
Default ChDrive and ChPath to a network drive

I got it-

Private Declare Function SetCurrentDirectoryA _
Lib "kernel32" (ByVal lpPathName As String) As Long

and

SetCurrentDirectoryA(sDirDefault)

:)

"ker_01" wrote:

Using 2003, although this workbook might also be used in 2007.

I adapted the code below to help me autoload sheets from other source
workbooks so that I can get all my raw data in one workbook without having to
manually copy/paste sheets.

In my initial testing of the following code, I used a local drive/path
(different folders on my desktop) and everything worked as expected.

However, now that I'm testing against the real path (LAN location), I'm
getting an error on ChDrive. I'm thinking that maybe ChDrive only works on
mapped drive letters? Since this workbook needs to work for multiple users
who will have the network drive mapped to different drive letters, I need to
use the raw path. Any suggestions?

Sub TestTheRawDataFunction
'sub works with a local drive path, but not with this network path
zz = PullAllRawData(Sheet1, Sheet15, _
"\\wabr833\Pemgt\Scorecard\Operations\RawData1 ", , _
"Select the current scorecard source file")
End Sub

Function PullAllRawData(SourceSheet As Worksheet, _
DestSheet As Worksheet, _
Optional PathOnly As String, _
Optional MyFullFilePath As String, _
Optional TitleString As String)

Dim SaveDriveDir As String

'save default path
SaveDriveDir = CurDir

If Len(TitleString) = 0 Then TitleString = "Please select the appropriate
file"

If Len(MyFullFilePath) 0 Then
'do nothing
ElseIf Len(PathOnly) 0 Then
'change to new path
ChDrive PathOnly '<< errors here, "invalid procedure call or argument"
ChDir PathOnly
'get the file
NewFN = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),
*.xls;*.xlsx;*.xlsm;*.csv", Title:=TitleString)
If NewFN = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
'return to original default path
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Function
Else
MyFullFilePath = NewFN
End If

'change back to default path
Else
'start from scratch

End If

Dim I As Integer
Dim owb As Workbook 'original/main
Dim twb As Workbook 'temp/data file
Dim ows As Worksheet
Dim tws As Worksheet

DestSheet.Activate
Set owb = ActiveWorkbook
Set ows = ActiveWorkbook.ActiveSheet
'clear the destination sheet to make sure there isn't leftover old data
ows.Cells.Clear

Application.StatusBar = "Opening File " & MyFullFilePath

'Open source workbook
Application.DisplayAlerts = False
Set twb = Workbooks.Open(Filename:=MyFullFilePath, UpdateLinks:=0,
ReadOnly:=True)
Application.DisplayAlerts = True
twb.Activate
twb.Sheets(1).Activate
'grab the data
twb.Sheets(1).Cells.Select
Selection.Copy
ows.Activate
ows.Range("A1").Select
ActiveSheet.Paste
ows.Range("A1").Select
ActiveSheet.PasteSpecial (xlPasteValuesAndNumberFormats)

'Select/copy a single cell to avoid clipboard warnings
ActiveSheet.Range("A1").Copy

'close the workbook to get it out of the way
Application.DisplayAlerts = False 'just in case the clipboard trick doesn't
work
twb.Close SaveChanges:=False
Application.DisplayAlerts = True

Application.StatusBar = False

'return to original default path
ChDrive SaveDriveDir
ChDir SaveDriveDir

End Function