0

ドキュメントのプロパティを更新し、存在しない場合は新しいエントリを作成しようとしています

ただし、このタイプのことは機能しません

Set objDocProps = DSO.GetDocumentProperties(sfilename:=FileName)

With objDocProps
If .CustomProperties("ABC") Is Nothing Then
'create it here

そこにエラーハンドラーを配置すると、ロックされているか、接続が失われているとバーフします

errhandler:
Select Case Err.Number
 Case -2147220987 ' missing custom property
 Debug.Print "missing custom property"
 With objDocProps
     .CustomProperties("ABC").Value = "banana!"
4

2 に答える 2

0

CustomDocumentProperties代わりに、適切なExcelブックのコレクションを使用できますか？次に、コレクションを繰り返し処理し、見つかった場合はプロパティを編集します。存在しない場合は、プロパティを作成できます

于 2009-04-05T00:58:02.103 に答える
0

CustomProperties に名前でアクセスしようとすると、問題が発生するようです。

私が実装した解決策は、CustomPropery コレクションを反復してアイテムのインデックスを決定し (存在する場合)、これを使用して値を設定する (または、存在しない場合は新しいものを追加する) ことです。

渡す: カスタム プロパティ オブジェクト、入力するエントリ、入力する値

Sub UpsertEntry(objCustomProps, entryname, entryvalue)
  'update the custom property with value supplied
  On Error Resume Next

  Dim icount 
  Dim iindex 

  For icount = 1 To objCustomProps.Count

    If objCustomProps.Item(icount).name = entryname Then
      iindex = icount
      Exit For
    Else
      iindex = 0
    End If

  Next


  If iindex = 0 Then 'no custom property found

   objCustomProps.Add entryname, entryvalue
   Wscript.Echo " Adding   [" & entryname & ":" & entryvalue & "]"
  Else
   objCustomProps.Item(iindex).Value = entryvalue
   Wscript.Echo " Changing [" & entryname & ":" & entryvalue & "]"

  End If
  On Error GoTo 0


End Sub
于 2009-04-21T11:49:51.127 に答える