Change Link source for OLE Objects with VBA

[kay.sarah.sarah]

I have about 30 OLE Objects in a Visio drawing linked to an Excel
workbook. Right now, when I need to point my drawing to a different
workbook, I have to use the Edit Links dialog box to manually change
the source of each object.

How can I do this programmatically using VBA? I have code that loops
through all the pages and OLE objects, but I don't know what to do with
the OLE object once I have it, to change the source file.

any suggestions?

 

[JuneTheSecond]

Though this is my test code.
Sub test()
Dim shp As Visio.Shape
Dim myole As Object
Dim mySheet As Excel.Worksheet
Dim ExcApp As Excel.Application
Dim exWin As Excel.Window
Dim myRange As Excel.Range

For Each shp In ActivePage.Shapes
Set myole = shp.Object
Set ExcApp = myole.Application
Set exWin = ExcApp.Windows(1)

exWin.Activate
Set mySheet = exWin.ActiveSheet
Set myRange = mySheet.Range("A1")

myRange.Value = 100
Debug.Print shp.Name, myRange.Address, myRange.Text
Next
End Sub

 

[kay.sarah.sarah]

Thanks, but I don't need to manipulate the data in the source workbook,
but instead change the workbook that the OLE object is linked to. Do
you have any advice about how to accomplish that?

 

[JuneTheSecond]

I apporogize that I dont catch your question.
By the way, ObjShape.Object fails when the ObjShape has
linked excel worksheet. It is the same case in OleObject.
I have not yet found another way to escape the error.

 

[JuneTheSecond]

This is a primitive example to replace linked Excel file.
Tis is very slow, as amost all operations are done by sendkeys method.
This program runs in VB.Net 2005.


'Module Module1
Imports System.Threading
Public Sub main()
Dim myShape As New clsShape
Dim myKey As New clsSendKeys
myShape.mySelect()
Thread.Sleep(1000)
myKey.OpenDialog()
Thread.Sleep(1000)
myKey.ReplaceLink()
End Sub
End Module

'Class clsShape
Public Class
Public Sub mySelect()
Dim app As Microsoft.Office.Interop.Visio.Application
app = GetObject(, "visio.application")
Dim shp As Microsoft.Office.Interop.Visio.Shape
shp = app.ActivePage.Shapes(1)
app.ActiveWindow.Select(shp,
Microsoft.Office.Interop.Visio.VisSelectArgs.visSelect)
shp = Nothing
app = Nothing
End Sub
End Class

'Class clsSendKeys
Public Class clsSendKeys
Public Sub OpenDialog()
AppActivate("Microsoft Visio")
My.Computer.Keyboard.SendKeys("%E", True)
My.Computer.Keyboard.SendKeys("k", True)
End Sub
Public Sub ReplaceLink()
AppActivate("Link") ' Link must be right caption of link dialog.
My.Computer.Keyboard.SendKeys("%C", True)
My.Computer.Keyboard.SendKeys("another.xls", True)
My.Computer.Keyboard.SendKeys("%O", True)
My.Computer.Keyboard.SendKeys("{ESC}", True)
End Sub
End Class

 

[JuneTheSecond]

Sorry ReplaceLink should be modified like,,,
Public Sub ReplaceLink()
AppActivate("リンク")
My.Computer.Keyboard.SendKeys("%C", True)
My.Computer.Keyboard.SendKeys("junichi.xls", True)
My.Computer.Keyboard.SendKeys("%O", True)
Thread.Sleep(1000)
My.Computer.Keyboard.SendKeys("%U", True)
My.Computer.Keyboard.SendKeys("{ESC}", True)
End Sub