PC Review


Reply
Thread Tools Rate Thread

ChDrive and ChPath to a network drive

 
 
ker_01
Guest
Posts: n/a
 
      26th Mar 2010
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



 
Reply With Quote
 
 
 
 
Dave Peterson
Guest
Posts: n/a
 
      26th Mar 2010
Yep. ChDrive and ChDir are limited to those mapped drives.

But Windows supplies an API that'll work for UNC paths as well as mapped
drives. So you could use something like this instead:

(Saved from an old post)

Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
Sub Loader1()

Dim myFileName As Variant
Dim myCurFolder As String
Dim myNewFolder As String

myCurFolder = CurDir
myNewFolder = "\\share\folder1\folder2"

On Error Resume Next
ChDirNet myNewFolder
If Err.Number <> 0 Then
'what should happen
MsgBox "Please change to your own folder"
Err.Clear
End If
On Error GoTo 0

myFileName = Application.GetOpenFilename(filefilter:="CSV Files, *.CSV", _
Title:="Pick a File")

ChDirNet myCurFolder

If myFileName = False Then
MsgBox "Ok, try later" 'user hit cancel
Exit Sub
End If

'do a bunch of work

End Sub

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


--

Dave Peterson
 
Reply With Quote
 
ker_01
Guest
Posts: n/a
 
      26th Mar 2010
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
>
>
>

 
Reply With Quote
 
phil K
Guest
Posts: n/a
 
      6th May 2011
Hi Dave,

I am having trouble with replacing the ChDrive function with the windows API. Would you be able to help me here? The Excel needs to be saved on a network drive which is not mapped on all computers.
I tried entering the code you have supplied but it will not work.

Thanks for your help!

Phil

Sub export()

Dim fname As Variant
Dim NewWb As Workbook
Dim FileFormatValue As Long


If Val(Application.Version) < 9 Then Exit Sub
If Val(Application.Version) < 12 Then




fname = Application.GetSaveAsFilename(InitialFileName:=Range("D143"), _
filefilter:="Excel Files (*.xls), *.xls", _
Title:="This example copies the ActiveSheet to a new workbook")

If fname <> False Then

ActiveSheet.Copy
Set NewWb = ActiveWorkbook


NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
NewWb.Close False
Set NewWb = Nothing

End If
Else

fname = Application.GetSaveAsFilename(InitialFileName:=Range("D143"), filefilter:= _
" Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
" Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
" Excel 2000-2003 Workbook (*.xls), *.xls," & _
" Excel Binary Workbook (*.xlsb), *.xlsb", _
FilterIndex:=1, Title:="This example copies the ActiveSheet to a new workbook")


If fname <> False Then
Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
Case "xls": FileFormatValue = 56
Case "xlsx": FileFormatValue = 51
Case "xlsm": FileFormatValue = 52
Case "xlsb": FileFormatValue = 50
Case Else: FileFormatValue = 0
End Select


If FileFormatValue = 0 Then
MsgBox "Sorry, unknown file extension"
Else

ActiveSheet.Copy
Set NewWb = ActiveWorkbook


NewWb.SaveAs fname, FileFormat:= _
FileFormatValue, CreateBackup:=False

Set NewWb = Nothing

End If
End If
End If

End Sub


> On Friday, March 26, 2010 6:09 PM 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 am testing against the real path (LAN location), I am
> getting an error on ChDrive. I am 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 is not 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 does not
> work
> twb.Close SaveChanges:=False
> Application.DisplayAlerts = True



>> On Friday, March 26, 2010 6:25 PM Dave Peterson wrote:


>> Yep. ChDrive and ChDir are limited to those mapped drives.
>>
>> But Windows supplies an API that will work for UNC paths as well as mapped
>> drives. So you could use something like this instead:
>>
>> (Saved from an old post)
>>
>> Option Explicit
>> Private Declare Function SetCurrentDirectoryA Lib _
>> "kernel32" (ByVal lpPathName As String) As Long
>> Sub ChDirNet(szPath As String)
>> Dim lReturn As Long
>> lReturn = SetCurrentDirectoryA(szPath)
>> If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
>> End Sub
>> Sub Loader1()
>>
>> Dim myFileName As Variant
>> Dim myCurFolder As String
>> Dim myNewFolder As String
>>
>> myCurFolder = CurDir
>> myNewFolder = "\\share\folder1\folder2"
>>
>> On Error Resume Next
>> ChDirNet myNewFolder
>> If Err.Number <> 0 Then
>> 'what should happen
>> MsgBox "Please change to your own folder"
>> Err.Clear
>> End If
>> On Error GoTo 0
>>
>> myFileName = Application.GetOpenFilename(filefilter:="CSV Files, *.CSV", _
>> Title:="Pick a File")
>>
>> ChDirNet myCurFolder
>>
>> If myFileName = False Then
>> MsgBox "Ok, try later" 'user hit cancel
>> Exit Sub
>> End If
>>
>> 'do a bunch of work
>>
>> End Sub
>>
>> ker_01 wrote:



>>> On Friday, March 26, 2010 6:27 PM ker_01 wrote:


>>> I got it-
>>>
>>> Private Declare Function SetCurrentDirectoryA _
>>> Lib "kernel32" (ByVal lpPathName As String) As Long
>>>
>>> and
>>>
>>> SetCurrentDirectoryA(sDirDefault)
>>>
>>>
>>> "ker_01" wrote:




 
Reply With Quote
 
Dave Peterson
Guest
Posts: n/a
 
      6th May 2011
Try including the UNC path in the initialfilename parm. I can't tell if it's
part of that value in that D143 cell.

(Untested.)

On 05/06/2011 06:01, phil K wrote:
> Hi Dave,
>
> I am having trouble with replacing the ChDrive function with the windows API. Would you be able to help me here? The Excel needs to be saved on a network drive which is not mapped on all computers.
> I tried entering the code you have supplied but it will not work.
>
> Thanks for your help!
>
> Phil
>
> Sub export()
>
> Dim fname As Variant
> Dim NewWb As Workbook
> Dim FileFormatValue As Long
>
>
> If Val(Application.Version)< 9 Then Exit Sub
> If Val(Application.Version)< 12 Then
>
>
>
>
> fname = Application.GetSaveAsFilename(InitialFileName:=Range("D143"), _
> filefilter:="Excel Files (*.xls), *.xls", _
> Title:="This example copies the ActiveSheet to a new workbook")
>
> If fname<> False Then
>
> ActiveSheet.Copy
> Set NewWb = ActiveWorkbook
>
>
> NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
> NewWb.Close False
> Set NewWb = Nothing
>
> End If
> Else
>
> fname = Application.GetSaveAsFilename(InitialFileName:=Range("D143"), filefilter:= _
> " Excel Macro Free Workbook (*.xlsx), *.xlsx,"& _
> " Excel Macro Enabled Workbook (*.xlsm), *.xlsm,"& _
> " Excel 2000-2003 Workbook (*.xls), *.xls,"& _
> " Excel Binary Workbook (*.xlsb), *.xlsb", _
> FilterIndex:=1, Title:="This example copies the ActiveSheet to a new workbook")
>
>
> If fname<> False Then
> Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
> Case "xls": FileFormatValue = 56
> Case "xlsx": FileFormatValue = 51
> Case "xlsm": FileFormatValue = 52
> Case "xlsb": FileFormatValue = 50
> Case Else: FileFormatValue = 0
> End Select
>
>
> If FileFormatValue = 0 Then
> MsgBox "Sorry, unknown file extension"
> Else
>
> ActiveSheet.Copy
> Set NewWb = ActiveWorkbook
>
>
> NewWb.SaveAs fname, FileFormat:= _
> FileFormatValue, CreateBackup:=False
>
> Set NewWb = Nothing
>
> End If
> End If
> End If
>
> End Sub
>
>
>> On Friday, March 26, 2010 6:09 PM 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 am testing against the real path (LAN location), I am
>> getting an error on ChDrive. I am 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 is not 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 does not
>> work
>> twb.Close SaveChanges:=False
>> Application.DisplayAlerts = True

>
>
>>> On Friday, March 26, 2010 6:25 PM Dave Peterson wrote:

>
>>> Yep. ChDrive and ChDir are limited to those mapped drives.
>>>
>>> But Windows supplies an API that will work for UNC paths as well as mapped
>>> drives. So you could use something like this instead:
>>>
>>> (Saved from an old post)
>>>
>>> Option Explicit
>>> Private Declare Function SetCurrentDirectoryA Lib _
>>> "kernel32" (ByVal lpPathName As String) As Long
>>> Sub ChDirNet(szPath As String)
>>> Dim lReturn As Long
>>> lReturn = SetCurrentDirectoryA(szPath)
>>> If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
>>> End Sub
>>> Sub Loader1()
>>>
>>> Dim myFileName As Variant
>>> Dim myCurFolder As String
>>> Dim myNewFolder As String
>>>
>>> myCurFolder = CurDir
>>> myNewFolder = "\\share\folder1\folder2"
>>>
>>> On Error Resume Next
>>> ChDirNet myNewFolder
>>> If Err.Number<> 0 Then
>>> 'what should happen
>>> MsgBox "Please change to your own folder"
>>> Err.Clear
>>> End If
>>> On Error GoTo 0
>>>
>>> myFileName = Application.GetOpenFilename(filefilter:="CSV Files, *.CSV", _
>>> Title:="Pick a File")
>>>
>>> ChDirNet myCurFolder
>>>
>>> If myFileName = False Then
>>> MsgBox "Ok, try later" 'user hit cancel
>>> Exit Sub
>>> End If
>>>
>>> 'do a bunch of work
>>>
>>> End Sub
>>>
>>> ker_01 wrote:

>
>
>>>> On Friday, March 26, 2010 6:27 PM ker_01 wrote:

>
>>>> I got it-
>>>>
>>>> Private Declare Function SetCurrentDirectoryA _
>>>> Lib "kernel32" (ByVal lpPathName As String) As Long
>>>>
>>>> and
>>>>
>>>> SetCurrentDirectoryA(sDirDefault)
>>>>
>>>>
>>>> "ker_01" wrote:

>
>
>


--
Dave Peterson
 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
ChDir and ChDrive Conan Kelly Microsoft Excel Programming 2 24th Dec 2008 09:26 PM
ChDrive error (server path) =?Utf-8?B?TWFyY290dGUgQQ==?= Microsoft Excel Programming 6 2nd Nov 2005 07:16 PM
Problems with ChDrive and ChDir Sophie Microsoft Excel Programming 6 3rd Dec 2004 10:52 AM
Problems with ChDrive, ChDir Sophie Microsoft Excel Programming 4 29th Nov 2004 09:35 AM
Help: ChDrive and/or ChDir for a non-mapped network drive Andrew Coyle Microsoft Access VBA Modules 1 1st Oct 2003 05:16 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 01:09 AM.