| Home | Forums | Reviews | Articles | Register |
![]() |
| Thread Tools | Rate Thread |
|
|
|
| |
|
Dave Peterson
Guest
Posts: n/a
|
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 |
|
||
|
||||
|
ker_01
Guest
Posts: n/a
|
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 > > > |
|
||
|
||||
|
phil K
Guest
Posts: n/a
|
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
Guest
Posts: n/a
|
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 |
|
||
|
||||
|
|
|
| |
![]() |
| Thread Tools | |
| Rate This Thread | |
|
|
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 |
Powered by vBulletin®. Copyright ©2000 - 2012, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2010, Crawlability, Inc. |




