在xml數據庫中檢查標記序列用word vba導出

我遇到了一個我正在編寫的宏的問題。我需要將導出文件從數據庫（術語表）轉換爲另一個標籤結構，以便能夠將其導入另一個數據庫。在xml數據庫中檢查標記序列用word vba導出

我做了幾乎所有的步驟，但我有什麼麻煩在做什麼，接下來。大多數條目都是雙語的。但是，有些條目具有多個值（最多3個）英文條目。

因此，我需要檢查標籤序列，如果找到雙英文條目，則將其轉換爲兩個條目。這個做完了。

問題是，即使宏查找到「正確」條目，而不是忽略它並跳轉到下一條，它會嘗試修改它，就像它錯了。

下面是宏代碼：

Sub CheckTagSequence() 
'DECLARATION OF VARIABLES 
Dim textline As String 
Dim SourceLang, TargetLang, EntryID As String 
Dim i As String 
Dim objWdRange As String 

'ASSIGNING VALUES TO THE VARIABLES 
SourceLang = "<enTerm>" 
TargetLang = "<frTerm>" 
i = "<entry id="">" 

'GO TO FIRST LINE 
Selection.GoTo what:=gotoline, which:=GoToFirst 
' MOVE DOWN TWO LINES 
Selection.MoveDown unit:=wdLine, Count:=2 
CONTINUA: 
If Left(textline, 8) = i Then ID = textline 
Selection.MoveDown unit:=wdLine, Count:=1 
If Left(textline, 8) = "<subject" Then su = textline 
Selection.MoveDown unit:=wdLine, Count:=1 
If Left(textline, 8) = SourcLang Then en = textline 
Selection.MoveDown unit:=wdLine, Count:=1 
**If Left(textline, 8) = TargetLang Then fr = textline 
Selection.MoveDown unit:=wdLine, Count:=1 
If Left(textline, 8) = "</entry>" Then** 
Selection.GoTo CONTINUA 
ElseIf Left(textline, 8) = SourceLang Then GoTo CORREGGI 
End If 

CORREGGI: 
Selection.MoveUp unit:=wdLine, Count:=3 
Selection.HomeKey unit:=wdLine 
Selection.MoveDown unit:=wdLine, Count:=2, Extend:=wdExtend 
Selection.Copy 
Selection.MoveDown unit:=wdLine, Count:=1 
Selection.Paste 
Selection.MoveDown unit:=wdLine, Count:=1 
Selection.MoveDown unit:=wdLine, Count:=2, Extend:=wdExtend 
Selection.Copy 
Selection.MoveUp unit:=wdLine, Count:=3 
Selection.HomeKey unit:=wdLine 
Selection.Paste 
Selection.MoveDown unit:=wdLine, Count:=1 
If Left(textline, 8) = i Then GoTo CONTINUA 
End Sub

它會阻止這些行：

If Left(textline, 8) = TargetLang Then fr = textline 
Selection.MoveDown unit:=wdLine, Count:=1 
If Left(textline, 8) = "</entry>" Then 
Selection.GoTo CONTINUA

這裏是一個示例文件的內容：

<?xml version=「1.0」 encoding=「UTF-8」?> 
<body> 
<entry id=「「> 
<subject>IRECRUITMENT</subject> 
<enTerm>Media Relations</enTerm> 
<frTerm>Relations avec les médias</frTerm> 
</entry> 
<entry id=「「> 
<subject>IRECRUITMENT</subject> 
<enTerm>OCEM</enTerm> 
<frTerm>Relations avec les médias</frTerm> 
</entry> 
<entry id=「「> 
<subject>IRECRUITMENT</subject> 
<enTerm>STATISTICS</enTerm> 
<enTerm>FIPSS</enTerm> 
<frTerm>STATISTIQUES</frTerm> 
</entry> 
<entry id=「「> 
<subject>IRECRUITMENT</subject> 
<enTerm>3rd Nationality</enTerm> 
<frTerm>3ème nationalité</frTerm> 
</entry> 
<entry id=」」> 
<subject>IRECRUITMENT</subject> 
<enTerm>FINANCE</enTerm> 
<enTerm>CSSDF</enTerm> 
<frTerm>FINANCES</frTerm> 
</entry> 
</body>

謝謝你提前尋求你的幫助！

來源

2013-10-09 Gionaf

我不會嘗試這樣的方式，或者甚至我會在這裏提出建議。我可能會嘗試將文本讀入MSXML對象並在其中操作XML樹，然後將其寫回。但是，如果您的數據如您所描述的那樣簡單，您只需要處理和處理元素，而且您只能擁有1,2或3個元素，那麼我認爲以下代碼將起作用，並會向您展示另一種可以開始的方式接近這種任務。但是，如果您的實際數據更加複雜，那麼仍然會有相當多的工作要做。

我在代碼之後做一些評論。

Sub reorgEntries() 
Const strFindEnTerm As String = "(\<enTerm\>*\</enTerm\>^13)" 
Dim i As Integer 
Dim rngContent As Word.Range 
Dim rngEntry As Word.Range 
Dim strFIndEntry As String 
Dim strFindEnTerms(2) As String 
Dim strReplaceEnTerms(2) As String 
' Finds a complete entry 
strFIndEntry = "^13\<entry*\</entry\>" 
' First find and replace entries with 3 En terms 
strFindEnTerms(1) = "(^13*)" & strFindEnTerm & strFindEnTerm & strFindEnTerm & "(*\</entry\>)" 
strReplaceEnTerms(1) = "\1\2\5\1\3\5\1\4\5" 
' Then with 2 terms 
strFindEnTerms(2) = "(^13*)" & strFindEnTerm & strFindEnTerm & "(*\</entry\>)" 
strReplaceEnTerms(2) = "\1\2\4\1\3\4" 
For i = 1 To 2 
    Call ClearFindAndReplaceParameters 
    Set rngContent = ActiveDocument.Range 
    With rngContent.Find 
    .ClearFormatting 
    .Text = strFIndEntry 
    .Replacement.Text = "" 
    .Forward = True 
    .Wrap = wdFindStop 
    .Format = False 
    .MatchCase = False 
    .MatchWholeWord = False 
    .MatchWildcards = True 
    .MatchSoundsLike = False 
    .MatchAllWordForms = False 
    While .Execute ' (Replace:=WdReplace.wdReplaceNone) 
     Set rngEntry = rngContent.Duplicate 
     With rngEntry.Find 
     .ClearFormatting 
     .Text = strFindEnTerms(i) 
     .Replacement.Text = strReplaceEnTerms(i) 
     .Forward = True 
     .Wrap = wdFindStop 
     .Format = False 
     .MatchCase = False 
     .MatchWholeWord = False 
     .MatchWildcards = True 
     .MatchSoundsLike = False 
     .MatchAllWordForms = False 
     While .Execute(Replace:=WdReplace.wdReplaceOne) 
     Wend 
     End With 
     Set rngEntry = Nothing 
    Wend 
    End With 
    Set rngContent = Nothing 
Next 
End Sub 

Sub ClearFindAndReplaceParameters() 

' You may need this to make wildcard searches 
' work properly after a failed wildcard search 
' (there is/was an error in Word) 
With Selection.Find 
    .ClearFormatting 
    .Replacement.ClearFormatting 
    .Text = "" 
    .Replacement.Text = "" 
    .Forward = True 
    .Wrap = wdFindStop 
    .Format = False 
    .MatchCase = False 
    .MatchWholeWord = False 
    .MatchWildcards = False 
    .MatchSoundsLike = False 
    .MatchAllWordForms = False 
End With 

End Sub

正如您所看到的，代碼使用Word的查找/替換方法進行替換，並且特別使用通配符匹配。這與使用「正則表達式」或「正則表達式」類似，但Word的內置正則表達式語法與大多數其他正則表達式語言不同（並且通常更不利於）。如果您對正則表達式不熟悉，可能需要一些時間才能理解其工作原理，但您可以通過互聯網搜索有關Word正則表達式的文章並將其解決。最重要的是，「（）」將正則表達式分組爲編號部分，並且當您用「\ 1 \ 2 \ 4 \ 1 \ 3 \ 4」替換您正在用部分1,2和4替換找到的文本時，然後是第1,3和4部分。

爲了使正則表達式更簡單，尋找「條目」的代碼循環，然後處理每個條目。僅搜索具有多個enTerm元素的條目相當困難 - 事實上，我甚至不確定在Word的正則表達式方言中是否可能。如果有人有正則表達式，我希望他們會告訴我們。

不幸的是，這個特定的代碼已經到了極限 - 如果你還必須搜索4個EnTerms，你不能簡單地擴展它，因爲你只能在Replace字符串中指定10個repelacmeent部分。

因爲您還必須考慮在進行替換後Ranges會發生什麼情況，所以在這種情況下在文本中進行兩次完整的傳遞更簡單。

現在，只需對您在此處發佈的代碼發表一些評論，以免您嘗試修復該問題。

您沒有設置一個TextLine（你需要將其設置爲Selection.Text或可能Selection.Paragraphs（1）。文本）
你會需要比較左（TextLine，將8）左（I，8），而不是與我
我想你可能會需要轉到康體而不是 Selection.Goto康體
作爲編程風格的問題，最好還是儘量避免轉到語句。除此之外，人們很難理解你實際想要達到的目標。

最後，變量名「i」通常用作整數變量，特別是作爲循環計數器等。對於臨時字符串，有些人會使用「s」。其他人總是使用更長的名字，如strEntry。

來源

2013-10-10 13:50:30

在xml數據庫中檢查標記序列用word vba導出

回答

相關問題