Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Excel / New Users / July 2006

Tip: Looking for answers? Try searching our database.

Problems saving a worksheet with Links

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
doctorjones_md@yahoo.com - 07 Jul 2006 15:06 GMT
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 - 07 Jul 2006 16:32 GMT
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

> 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
[quoted text clipped - 19 lines]
>
> Many Thanks in Advance.

Signature

Dave Peterson

doctorjones_md@yahoo.com - 07 Jul 2006 19:20 GMT
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!
================================================
>I think that this does it:
>
[quoted text clipped - 97 lines]
>>
>> Many Thanks in Advance.
Dave Peterson - 07 Jul 2006 19:30 GMT
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

> 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
[quoted text clipped - 113 lines]
> >
> > Dave Peterson

Signature

Dave Peterson

doctorjones_md - 12 Jul 2006 10:59 GMT
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! :)

> You can incorporate some of the code from one of these sites:
>
[quoted text clipped - 265 lines]
>> >
>> > Dave Peterson

Rate this thread:






 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.