Problems saving a worksheet with Links

Does anyone know how I can resolve this issue ... I have a directory which
contains 129 worksheets which have links to external data (in a Master
Spreadsheet) -- I need to copy these files into a New Directory, but kee the
Master Spreadsheet (which they are linked to) in the original location. If
I do a simple Cut & Past, the Reference Link to the Master Spreadsheet gets
moved to the New Directory (where the file does not exist), but if I open
the worksheet (in the original directory/location) and Save As to the New
Directory, the worksheet saved in the New Directory maintains its link to
the Master Spreadsheet in the original directory/location. I hope I've
explained this clearly.

Here's my problem -- it's a bit time consuming to have to open each and
every worksheet and Save As to the New Location -- I'm not sure if a Batch
File (or Dos Command xcopy) would solve this -- Is there some code I could
use to Open each worksheet, Save As to the New directory, Close, then
perform this on each of the .xls files in the original directory? If so,
could you please point me in the direction with an example of the code.

Example:

Files in C:\Temp (a.xls, b.xls, c.xls) Copied to C:\Budget

Many Thanks in Advance.

I think that this does it:

Option Explicit
Sub testme01()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myOldPath As String
Dim myNewPath As String
Dim MstrFileName As String
Dim TempWkbk As Workbook

'change to point at the old folder
myOldPath = "c:\my documents\excel\"
If Right(myOldPath, 1) <> "\" Then
myOldPath = myOldPath & "\"
End If

'change to point at the new folder
myNewPath = "c:\temp"
If Right(myNewPath, 1) <> "\" Then
myNewPath = myNewPath & "\"
End If

'the master file--not to be copied
MstrFileName = "mstr.xls"

myFile = ""
On Error Resume Next
myFile = Dir(myOldPath & "*.xls")
On Error GoTo 0
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

Application.ScreenUpdating = False

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
If LCase(myNames(fCtr)) = LCase(MstrFileName) Then
'do nothing, skip the master file
Else
Application.StatusBar _
= "Processing: " & myNames(fCtr) & " at: " & Now

Set TempWkbk = Workbooks.Open(Filename:=myOldPath _
& myNames(fCtr), ReadOnly:=True)

TempWkbk.SaveAs Filename:=myNewPath & myNames(fCtr)
TempWkbk.Close savechanges:=False
End If
Next fCtr
End If

With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub



[email protected] wrote:
>
> Does anyone know how I can resolve this issue ... I have a directory which
> contains 129 worksheets which have links to external data (in a Master
> Spreadsheet) -- I need to copy these files into a New Directory, but kee the
> Master Spreadsheet (which they are linked to) in the original location. If
> I do a simple Cut & Past, the Reference Link to the Master Spreadsheet gets
> moved to the New Directory (where the file does not exist), but if I open
> the worksheet (in the original directory/location) and Save As to the New
> Directory, the worksheet saved in the New Directory maintains its link to
> the Master Spreadsheet in the original directory/location. I hope I've
> explained this clearly.
>
> Here's my problem -- it's a bit time consuming to have to open each and
> every worksheet and Save As to the New Location -- I'm not sure if a Batch
> File (or Dos Command xcopy) would solve this -- Is there some code I could
> use to Open each worksheet, Save As to the New directory, Close, then
> perform this on each of the .xls files in the original directory? If so,
> could you please point me in the direction with an example of the code.
>
> Example:
>
> Files in C:\Temp (a.xls, b.xls, c.xls) Copied to C:\Budget
>
> Many Thanks in Advance.

--

Dave Peterson

Dave -- Thank you for your assistance -- the code worked brillantly! It's
Friday, so I hate to press my luck on this one, but is it possible to modify
the code to allow for INPUT boxes for myOldPath & myNewPath (so that a user
could designate the origination/destination paths without having to tinker
with the code)? Ideally, I'd like to placed a Command Button on the EXCEL
worksheet, and when Pressed, display the (2) Input Boxes for myOldPath &
myNewPath.

Any ideas on this modification?

Thanks again for your previous assistance!
================================================
"Dave Peterson" <[email protected]> wrote in message
news:[email protected]...
>I think that this does it:
>
> Option Explicit
> Sub testme01()
>
> Dim myNames() As String
> Dim fCtr As Long
> Dim myFile As String
> Dim myOldPath As String
> Dim myNewPath As String
> Dim MstrFileName As String
> Dim TempWkbk As Workbook
>
> 'change to point at the old folder
> myOldPath = "c:\my documents\excel\"
> If Right(myOldPath, 1) <> "\" Then
> myOldPath = myOldPath & "\"
> End If
>
> 'change to point at the new folder
> myNewPath = "c:\temp"
> If Right(myNewPath, 1) <> "\" Then
> myNewPath = myNewPath & "\"
> End If
>
> 'the master file--not to be copied
> MstrFileName = "mstr.xls"
>
> myFile = ""
> On Error Resume Next
> myFile = Dir(myOldPath & "*.xls")
> On Error GoTo 0
> If myFile = "" Then
> MsgBox "no files found"
> Exit Sub
> End If
>
> Application.ScreenUpdating = False
>
> 'get the list of files
> fCtr = 0
> Do While myFile <> ""
> fCtr = fCtr + 1
> ReDim Preserve myNames(1 To fCtr)
> myNames(fCtr) = myFile
> myFile = Dir()
> Loop
>
> If fCtr > 0 Then
> For fCtr = LBound(myNames) To UBound(myNames)
> If LCase(myNames(fCtr)) = LCase(MstrFileName) Then
> 'do nothing, skip the master file
> Else
> Application.StatusBar _
> = "Processing: " & myNames(fCtr) & " at: " & Now
>
> Set TempWkbk = Workbooks.Open(Filename:=myOldPath _
> & myNames(fCtr), ReadOnly:=True)
>
> TempWkbk.SaveAs Filename:=myNewPath & myNames(fCtr)
> TempWkbk.Close savechanges:=False
> End If
> Next fCtr
> End If
>
> With Application
> .ScreenUpdating = True
> .StatusBar = False
> End With
>
> End Sub
>
>
>
> [email protected] wrote:
>>
>> Does anyone know how I can resolve this issue ... I have a directory
>> which
>> contains 129 worksheets which have links to external data (in a Master
>> Spreadsheet) -- I need to copy these files into a New Directory, but kee
>> the
>> Master Spreadsheet (which they are linked to) in the original location.
>> If
>> I do a simple Cut & Past, the Reference Link to the Master Spreadsheet
>> gets
>> moved to the New Directory (where the file does not exist), but if I open
>> the worksheet (in the original directory/location) and Save As to the New
>> Directory, the worksheet saved in the New Directory maintains its link to
>> the Master Spreadsheet in the original directory/location. I hope I've
>> explained this clearly.
>>
>> Here's my problem -- it's a bit time consuming to have to open each and
>> every worksheet and Save As to the New Location -- I'm not sure if a
>> Batch
>> File (or Dos Command xcopy) would solve this -- Is there some code I
>> could
>> use to Open each worksheet, Save As to the New directory, Close, then
>> perform this on each of the .xls files in the original directory? If so,
>> could you please point me in the direction with an example of the code.
>>
>> Example:
>>
>> Files in C:\Temp (a.xls, b.xls, c.xls) Copied to C:\Budget
>>
>> Many Thanks in Advance.
>
> --
>
> Dave Peterson

You can incorporate some of the code from one of these sites:

Jim Rech has a BrowseForFolder routine at:
http://www.oaltd.co.uk/MVP/Default.htm
(look for BrowseForFolder)

John Walkenbach has one at:
http://j-walk.com/ss/excel/tips/tip29.htm

Your main routine will be:

Option Explicit
Sub testme01()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myOldPath As String
Dim myNewPath As String
Dim MstrFileName As String
Dim TempWkbk As Workbook

'change to point at the old folder
myOldPath = GetDirectory("Select OLD Folder")
If myOldPath = "" Then Exit Sub
If Right(myOldPath, 1) <> "\" Then
myOldPath = myOldPath & "\"
End If

'change to point at the new folder
myNewPath = GetDirectory("Select NEW Folder")
If myNewPath = "" Then Exit Sub
If Right(myNewPath, 1) <> "\" Then
myNewPath = myNewPath & "\"
End If

MstrFileName = "mstr.xls"

myFile = ""
On Error Resume Next
myFile = Dir(myOldPath & "*.xls")
On Error GoTo 0
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

Application.ScreenUpdating = False

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
If LCase(myNames(fCtr)) = LCase(MstrFileName) Then
'do nothing, skip the master file
Else
Application.StatusBar _
= "Processing: " & myNames(fCtr) & " at: " & Now

Set TempWkbk = Workbooks.Open(Filename:=myOldPath _
& myNames(fCtr), ReadOnly:=True)

TempWkbk.SaveAs Filename:=myNewPath & myNames(fCtr)
TempWkbk.Close savechanges:=False
End If
Next fCtr
End If

With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub

But in a different module, put all this code (From John Walkenbach's site):

Option Explicit
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) _
As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long


Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

' Root folder = Desktop
bInfo.pidlRoot = 0&

' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

' Type of directory to return
bInfo.ulFlags = &H1

' Display the dialog
x = SHBrowseForFolder(bInfo)

' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function





[email protected] wrote:
>
> Dave -- Thank you for your assistance -- the code worked brillantly! It's
> Friday, so I hate to press my luck on this one, but is it possible to modify
> the code to allow for INPUT boxes for myOldPath & myNewPath (so that a user
> could designate the origination/destination paths without having to tinker
> with the code)? Ideally, I'd like to placed a Command Button on the EXCEL
> worksheet, and when Pressed, display the (2) Input Boxes for myOldPath &
> myNewPath.
>
> Any ideas on this modification?
>
> Thanks again for your previous assistance!
> ================================================
> "Dave Peterson" <[email protected]> wrote in message
> news:[email protected]...
> >I think that this does it:
> >
> > Option Explicit
> > Sub testme01()
> >
> > Dim myNames() As String
> > Dim fCtr As Long
> > Dim myFile As String
> > Dim myOldPath As String
> > Dim myNewPath As String
> > Dim MstrFileName As String
> > Dim TempWkbk As Workbook
> >
> > 'change to point at the old folder
> > myOldPath = "c:\my documents\excel\"
> > If Right(myOldPath, 1) <> "\" Then
> > myOldPath = myOldPath & "\"
> > End If
> >
> > 'change to point at the new folder
> > myNewPath = "c:\temp"
> > If Right(myNewPath, 1) <> "\" Then
> > myNewPath = myNewPath & "\"
> > End If
> >
> > 'the master file--not to be copied
> > MstrFileName = "mstr.xls"
> >
> > myFile = ""
> > On Error Resume Next
> > myFile = Dir(myOldPath & "*.xls")
> > On Error GoTo 0
> > If myFile = "" Then
> > MsgBox "no files found"
> > Exit Sub
> > End If
> >
> > Application.ScreenUpdating = False
> >
> > 'get the list of files
> > fCtr = 0
> > Do While myFile <> ""
> > fCtr = fCtr + 1
> > ReDim Preserve myNames(1 To fCtr)
> > myNames(fCtr) = myFile
> > myFile = Dir()
> > Loop
> >
> > If fCtr > 0 Then
> > For fCtr = LBound(myNames) To UBound(myNames)
> > If LCase(myNames(fCtr)) = LCase(MstrFileName) Then
> > 'do nothing, skip the master file
> > Else
> > Application.StatusBar _
> > = "Processing: " & myNames(fCtr) & " at: " & Now
> >
> > Set TempWkbk = Workbooks.Open(Filename:=myOldPath _
> > & myNames(fCtr), ReadOnly:=True)
> >
> > TempWkbk.SaveAs Filename:=myNewPath & myNames(fCtr)
> > TempWkbk.Close savechanges:=False
> > End If
> > Next fCtr
> > End If
> >
> > With Application
> > .ScreenUpdating = True
> > .StatusBar = False
> > End With
> >
> > End Sub
> >
> >
> >
> > [email protected] wrote:
> >>
> >> Does anyone know how I can resolve this issue ... I have a directory
> >> which
> >> contains 129 worksheets which have links to external data (in a Master
> >> Spreadsheet) -- I need to copy these files into a New Directory, but kee
> >> the
> >> Master Spreadsheet (which they are linked to) in the original location.
> >> If
> >> I do a simple Cut & Past, the Reference Link to the Master Spreadsheet
> >> gets
> >> moved to the New Directory (where the file does not exist), but if I open
> >> the worksheet (in the original directory/location) and Save As to the New
> >> Directory, the worksheet saved in the New Directory maintains its link to
> >> the Master Spreadsheet in the original directory/location. I hope I've
> >> explained this clearly.
> >>
> >> Here's my problem -- it's a bit time consuming to have to open each and
> >> every worksheet and Save As to the New Location -- I'm not sure if a
> >> Batch
> >> File (or Dos Command xcopy) would solve this -- Is there some code I
> >> could
> >> use to Open each worksheet, Save As to the New directory, Close, then
> >> perform this on each of the .xls files in the original directory? If so,
> >> could you please point me in the direction with an example of the code.
> >>
> >> Example:
> >>
> >> Files in C:\Temp (a.xls, b.xls, c.xls) Copied to C:\Budget
> >>
> >> Many Thanks in Advance.
> >
> > --
> >
> > Dave Peterson

--

Dave Peterson

Dave -- sorry the the delayed response to your follow-up assistance (with
the Browse To Option from John Walkenbach's site) -- this works
Brillantly" -- many thanks to you for all your assistance!


"Dave Peterson" <[email protected]> wrote in message
news:[email protected]...
> You can incorporate some of the code from one of these sites:
>
> Jim Rech has a BrowseForFolder routine at:
> http://www.oaltd.co.uk/MVP/Default.htm
> (look for BrowseForFolder)
>
> John Walkenbach has one at:
> http://j-walk.com/ss/excel/tips/tip29.htm
>
> Your main routine will be:
>
> Option Explicit
> Sub testme01()
>
> Dim myNames() As String
> Dim fCtr As Long
> Dim myFile As String
> Dim myOldPath As String
> Dim myNewPath As String
> Dim MstrFileName As String
> Dim TempWkbk As Workbook
>
> 'change to point at the old folder
> myOldPath = GetDirectory("Select OLD Folder")
> If myOldPath = "" Then Exit Sub
> If Right(myOldPath, 1) <> "\" Then
> myOldPath = myOldPath & "\"
> End If
>
> 'change to point at the new folder
> myNewPath = GetDirectory("Select NEW Folder")
> If myNewPath = "" Then Exit Sub
> If Right(myNewPath, 1) <> "\" Then
> myNewPath = myNewPath & "\"
> End If
>
> MstrFileName = "mstr.xls"
>
> myFile = ""
> On Error Resume Next
> myFile = Dir(myOldPath & "*.xls")
> On Error GoTo 0
> If myFile = "" Then
> MsgBox "no files found"
> Exit Sub
> End If
>
> Application.ScreenUpdating = False
>
> 'get the list of files
> fCtr = 0
> Do While myFile <> ""
> fCtr = fCtr + 1
> ReDim Preserve myNames(1 To fCtr)
> myNames(fCtr) = myFile
> myFile = Dir()
> Loop
>
> If fCtr > 0 Then
> For fCtr = LBound(myNames) To UBound(myNames)
> If LCase(myNames(fCtr)) = LCase(MstrFileName) Then
> 'do nothing, skip the master file
> Else
> Application.StatusBar _
> = "Processing: " & myNames(fCtr) & " at: " & Now
>
> Set TempWkbk = Workbooks.Open(Filename:=myOldPath _
> & myNames(fCtr), ReadOnly:=True)
>
> TempWkbk.SaveAs Filename:=myNewPath & myNames(fCtr)
> TempWkbk.Close savechanges:=False
> End If
> Next fCtr
> End If
>
> With Application
> .ScreenUpdating = True
> .StatusBar = False
> End With
>
> End Sub
>
> But in a different module, put all this code (From John Walkenbach's
> site):
>
> Option Explicit
> Public Type BROWSEINFO
> hOwner As Long
> pidlRoot As Long
> pszDisplayName As String
> lpszTitle As String
> ulFlags As Long
> lpfn As Long
> lParam As Long
> iImage As Long
> End Type
>
> '32-bit API declarations
> Declare Function SHGetPathFromIDList Lib "shell32.dll" _
> Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As
> String) _
> As Long
>
> Declare Function SHBrowseForFolder Lib "shell32.dll" _
> Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
>
>
> Function GetDirectory(Optional Msg) As String
> Dim bInfo As BROWSEINFO
> Dim path As String
> Dim r As Long, x As Long, pos As Integer
>
> ' Root folder = Desktop
> bInfo.pidlRoot = 0&
>
> ' Title in the dialog
> If IsMissing(Msg) Then
> bInfo.lpszTitle = "Select a folder."
> Else
> bInfo.lpszTitle = Msg
> End If
>
> ' Type of directory to return
> bInfo.ulFlags = &H1
>
> ' Display the dialog
> x = SHBrowseForFolder(bInfo)
>
> ' Parse the result
> path = Space$(512)
> r = SHGetPathFromIDList(ByVal x, ByVal path)
> If r Then
> pos = InStr(path, Chr$(0))
> GetDirectory = Left(path, pos - 1)
> Else
> GetDirectory = ""
> End If
> End Function
>
>
>
>
>
> [email protected] wrote:
>>
>> Dave -- Thank you for your assistance -- the code worked brillantly!
>> It's
>> Friday, so I hate to press my luck on this one, but is it possible to
>> modify
>> the code to allow for INPUT boxes for myOldPath & myNewPath (so that a
>> user
>> could designate the origination/destination paths without having to
>> tinker
>> with the code)? Ideally, I'd like to placed a Command Button on the
>> EXCEL
>> worksheet, and when Pressed, display the (2) Input Boxes for myOldPath &
>> myNewPath.
>>
>> Any ideas on this modification?
>>
>> Thanks again for your previous assistance!
>> ================================================
>> "Dave Peterson" <[email protected]> wrote in message
>> news:[email protected]...
>> >I think that this does it:
>> >
>> > Option Explicit
>> > Sub testme01()
>> >
>> > Dim myNames() As String
>> > Dim fCtr As Long
>> > Dim myFile As String
>> > Dim myOldPath As String
>> > Dim myNewPath As String
>> > Dim MstrFileName As String
>> > Dim TempWkbk As Workbook
>> >
>> > 'change to point at the old folder
>> > myOldPath = "c:\my documents\excel\"
>> > If Right(myOldPath, 1) <> "\" Then
>> > myOldPath = myOldPath & "\"
>> > End If
>> >
>> > 'change to point at the new folder
>> > myNewPath = "c:\temp"
>> > If Right(myNewPath, 1) <> "\" Then
>> > myNewPath = myNewPath & "\"
>> > End If
>> >
>> > 'the master file--not to be copied
>> > MstrFileName = "mstr.xls"
>> >
>> > myFile = ""
>> > On Error Resume Next
>> > myFile = Dir(myOldPath & "*.xls")
>> > On Error GoTo 0
>> > If myFile = "" Then
>> > MsgBox "no files found"
>> > Exit Sub
>> > End If
>> >
>> > Application.ScreenUpdating = False
>> >
>> > 'get the list of files
>> > fCtr = 0
>> > Do While myFile <> ""
>> > fCtr = fCtr + 1
>> > ReDim Preserve myNames(1 To fCtr)
>> > myNames(fCtr) = myFile
>> > myFile = Dir()
>> > Loop
>> >
>> > If fCtr > 0 Then
>> > For fCtr = LBound(myNames) To UBound(myNames)
>> > If LCase(myNames(fCtr)) = LCase(MstrFileName) Then
>> > 'do nothing, skip the master file
>> > Else
>> > Application.StatusBar _
>> > = "Processing: " & myNames(fCtr) & " at: " & Now
>> >
>> > Set TempWkbk = Workbooks.Open(Filename:=myOldPath _
>> > & myNames(fCtr), ReadOnly:=True)
>> >
>> > TempWkbk.SaveAs Filename:=myNewPath & myNames(fCtr)
>> > TempWkbk.Close savechanges:=False
>> > End If
>> > Next fCtr
>> > End If
>> >
>> > With Application
>> > .ScreenUpdating = True
>> > .StatusBar = False
>> > End With
>> >
>> > End Sub
>> >
>> >
>> >
>> > [email protected] wrote:
>> >>
>> >> Does anyone know how I can resolve this issue ... I have a directory
>> >> which
>> >> contains 129 worksheets which have links to external data (in a Master
>> >> Spreadsheet) -- I need to copy these files into a New Directory, but
>> >> kee
>> >> the
>> >> Master Spreadsheet (which they are linked to) in the original
>> >> location.
>> >> If
>> >> I do a simple Cut & Past, the Reference Link to the Master Spreadsheet
>> >> gets
>> >> moved to the New Directory (where the file does not exist), but if I
>> >> open
>> >> the worksheet (in the original directory/location) and Save As to the
>> >> New
>> >> Directory, the worksheet saved in the New Directory maintains its link
>> >> to
>> >> the Master Spreadsheet in the original directory/location. I hope
>> >> I've
>> >> explained this clearly.
>> >>
>> >> Here's my problem -- it's a bit time consuming to have to open each
>> >> and
>> >> every worksheet and Save As to the New Location -- I'm not sure if a
>> >> Batch
>> >> File (or Dos Command xcopy) would solve this -- Is there some code I
>> >> could
>> >> use to Open each worksheet, Save As to the New directory, Close, then
>> >> perform this on each of the .xls files in the original directory? If
>> >> so,
>> >> could you please point me in the direction with an example of the
>> >> code.
>> >>
>> >> Example:
>> >>
>> >> Files in C:\Temp (a.xls, b.xls, c.xls) Copied to C:\Budget
>> >>
>> >> Many Thanks in Advance.
>> >
>> > --
>> >
>> > Dave Peterson
>
> --
>
> Dave Peterson