Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel VBA: moving folders on the server
Hi VB debuggers!
I coded VBA in Excel 2003 to move folders on the server. The code will excute when the user selects an item from a combo box on the worksheet and then clicks Save. My mind is toggling because the code runs perfect when I open the file on my C:/ drive. It fails when I run the file on the server, where it is suppose to opeate. For some reason, I can move the folder once, but then it fails. I get a dialog box "Specified path cannot be found" Where did I go wrong? Please help and continue to enjoy life! Myrna Rodriguez 'Florida is Sunny' *** Sent via Developersdex http://www.developersdex.com *** |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel VBA: moving folders on the server
Might help to see the code.
-- HTH RP (remove nothere from the email address if mailing direct) "Myrna Rodriguez" wrote in message ... Hi VB debuggers! I coded VBA in Excel 2003 to move folders on the server. The code will excute when the user selects an item from a combo box on the worksheet and then clicks Save. My mind is toggling because the code runs perfect when I open the file on my C:/ drive. It fails when I run the file on the server, where it is suppose to opeate. For some reason, I can move the folder once, but then it fails. I get a dialog box "Specified path cannot be found" Where did I go wrong? Please help and continue to enjoy life! Myrna Rodriguez 'Florida is Sunny' *** Sent via Developersdex http://www.developersdex.com *** |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel VBA: moving folders on the server
THE CODE RUNS ON MY C"/DRIVE, BUT FAILS WHEN I RUN IT ON THE SERVER,
WHICH IS MAPPED ON S:/DRIVE. I'VE SET THE PATH DRIVE TO S:/ REGENERATELINKS(code below)CHANGES THE HYPERLINK ADDRESS AND SHOULD BE ABLE TO MOVE FOLDERS DEPENDENT ON THE COMBO BOX IN COLUMN P IN EXCEL WORKSHEET. THE HYPERLINK ADDRESS IS WORKING PROPERLY, BUT STILL HAVING PROBLEMS RUNNING THE CODE ON THE SERVER. THANKS FOR HELPING. MYRNA RODRIGUEZ "THIS IS THE CODE TO MOVE THE FOLDERS" Sub RegenerateLinks() 'Declarations Dim Nextrow As Long Dim myRange As Range Dim x As String Dim cell As Range Dim fastNumValue As String Dim fileLocation As String Dim link As String Dim rowCount As Integer Dim h As Hyperlink Dim newAddress As String Dim debugThis As Boolean Dim newfolder As String debugThis = False rowCount = 0 Set myRange = Range("A3").CurrentRegion For Each rw In Worksheets(1).Cells(1, 1).CurrentRegion.Rows rowCount = rowCount + 1 fastNumValue = rw.Cells(1, 1).Value If debugThis Then MsgBox "fastNumValue : " & fastNumValue fileLocation = rw.Cells(1, 16).Value If debugThis Then MsgBox "fileLocation : " & fileLocation For Each h In rw.Hyperlinks 'MsgBox ActiveWorkbook.FullName link = h.Name If debugThis Then MsgBox "link h.name : " & link If InStr(fileLocation, "Open") < 0 Then If InStr(h.Name, "Open") < 0 Then If debugThis Then MsgBox "is ok" ElseIf InStr(h.Name, "Post-Close") < 0 Then If debugThis Then MsgBox "not ok" newAddress = Replace(h.Address, "Post-Close", "Open") If debugThis Then MsgBox "newAddress : " & newAddress 'moving the files now oldFullAddress = HyperLinkTextH(h) If debugThis Then MsgBox "oldFullAddress : " & oldFullAddress newFullAddress = Replace(oldFullAddress, "Post-Close", "Open") If debugThis Then MsgBox "newFullAddress : " & newFullAddress Set fso = CreateObject("Scripting.FileSystemObject") 'check if file exists first If fso.folderexists(oldFullAddress) Then Set mainfolder = fso.GetFolder(oldFullAddress) mainfolder.Move newFullAddress End If h.Address = newAddress If debugThis Then MsgBox "newAddress added : " & h.Address Function HyperLinkTextH(h As Hyperlink) As String Dim ST1 As String Dim ST2 As String Dim LPath As String Dim ST1Local As String 'If pRange.Hyperlinks.Count = 0 Then ' Exit Function 'End If If debugThis Then MsgBox "HyperLinkTextH : " & h.Name LPath = ThisWorkbook.FullName ST1 = h.Address ST2 = h.SubAddress If Mid(ST1, 1, 15) = "..\..\..\..\..\" Then ST1Local = ReturnPath(LPath, 5) & Mid(ST1, 15) ElseIf Mid(ST1, 1, 12) = "..\..\..\..\" Then ST1Local = ReturnPath(LPath, 4) & Mid(ST1, 12) ElseIf Mid(ST1, 1, 9) = "..\..\..\" Then ST1Local = ReturnPath(LPath, 3) & Mid(ST1, 9) ElseIf Mid(ST1, 1, 6) = "..\..\" Then ST1Local = ReturnPath(LPath, 2) & Mid(ST1, 6) ElseIf Mid(ST1, 1, 3) = "..\" Then ST1Local = ReturnPath(LPath, 1) & Mid(ST1, 3) ElseIf Mid(ST1, 1, 15) = "../../../../../" Then ST1Local = ReturnPath(LPath, 5) & Mid(ST1, 15) ElseIf Mid(ST1, 1, 12) = "../../../../" Then ST1Local = ReturnPath(LPath, 4) & Mid(ST1, 12) ElseIf Mid(ST1, 1, 9) = "../../../" Then ST1Local = ReturnPath(LPath, 3) & Mid(ST1, 9) ElseIf Mid(ST1, 1, 6) = "../../" Then ST1Local = ReturnPath(LPath, 2) & Mid(ST1, 6) ElseIf Mid(ST1, 1, 3) = "../" Then ST1Local = ReturnPath(LPath, 1) & Mid(ST1, 3) Else ST1Local = ST1 End If If ST2 < "" Then ST1Local = "[" & ST1Local & "]" & ST2 End If If debugThis Then MsgBox "ST1Local : " & ST1Local HyperLinkTextH = ST1Local End Function Function ReturnPath(pAppPath As String, pCount As Integer) As String Dim LPos As Integer Dim LTotal As Integer Dim LLength As Integer LTotal = 0 LLength = Len(pAppPath) Do Until LTotal = pCount + 1 If Mid(pAppPath, LLength, 1) = "\" Then LTotal = LTotal + 1 End If LLength = LLength - 1 Loop ReturnPath = Mid(pAppPath, 1, LLength) End Function *** Sent via Developersdex http://www.developersdex.com *** |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Moving linked files from one server to anoter one | Excel Worksheet Functions | |||
Read- only Protect Folders and contents in WIN2K Server | Excel Discussion (Misc queries) | |||
Moving workbooks between folders | Excel Discussion (Misc queries) | |||
moving folders | Excel Programming |