VBA Word запрос к базе данных.

[rikomono]

Помогите написать макрос.
1)   Имеется текст в редакторе Word
2)   Нужно чтобы по каждому слову был сделан запрос к базе данных или к книги Exel
3)   Это слово там найдено.
4)   Слово находящееся в ячейке  справа было помещено на слово в исходном тексте с помощью (PhoneticGuide)
5)   А если слова нет в базе данных, то слово в тексте заключалось  бы в такие скобки <слово>
 

Добавлено через 1 час, 14 минут и 59 секунд:
У меня есть такой макрос.
Я его переделал из другого насколько хватило мозгов. Но как сделать чтобы происходило обращение к базе данных Access или книги Exel, а не просто помещения текста между кавычками на слово слева?

(click to show)

Sub Trans()
Dim s As String
Do
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = ChrW(12298) & "*" & ChrW(12299)
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute
    s = Selection.Text
    If Len(s) < 2 Then Exit Sub 'нет искомого текста, конец работы
    s = Mid(s, 2, Len(s) - 2)   'удалить первый и последний символ
    Selection.Cut
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
    Selection.Range.PhoneticGuide Text:=s, _
        Alignment:=wdPhoneticGuideAlignmentOneTwoOne, Raise:=14, FontSize:=10 _
        , FontName:="Lucida Sans Unicode"
Loop
End Sub

Добавлено через 10 минут и 16 секунд:
Немного поправлю свой вопрос.
1)   Имеется текст в редакторе Word
2)   Нужно чтобы по каждому слову был сделан запрос к базе данных Access или к книги Exel
3)   Поиск слова в поле "ААА".
4)   Слово находящееся в ячейке поля "ВВВ"  справа от слова в поле "ААА" было помещено на слово в исходном тексте с помощью (PhoneticGuide)
5)   А если слова нет в базе данных, то слово в тексте заключалось  бы в такие скобки <слово>
 

[HandKot]

примерно так, но, скажу сразу, макрос не работает
придется доработать напильником 

Код:

Public Sub test()
    Dim w As Range
    Dim i As Integer
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    
    'открываем соединение к БД
    Set cn = New ADODB.Connection
    cn.ConnectionString = "тута строка подключения"
    
    'бежим по всем словам в тексте
    For i = 1 To ThisDocument.Words.Count
        'ищем слово в БД
        rs.Open cn, "select BBB from Таблица where AAA = '" + w.Text + "'"
        
        'Слово находящееся в ячейке поля "ВВВ"  справа от слова в поле "ААА" было помещено на слово в исходном тексте с помощью (PhoneticGuide
        If Not rs.EOF Then
            Set w = ThisDocument.Words.Item(i)
            If Asc(w.Text) > 30 Then w.PhoneticGuide Text:="qqq", Alignment:=wdPhoneticGuideAlignmentOneTwoOne, Raise:=14, FontSize:=10, FontName:="Lucida Sans Unicode"
        
        ' А если слова нет в базе данных, то слово в тексте заключалось  бы в такие скобки <слово>
        Else
             w.Text = "<" + w.Text + ">"
        End If
        rs.Close
    Next
    
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

[rikomono]

примерно так, но, скажу сразу, макрос не работает
придется доработать напильником 

Спасибо. Пойду искать напильник, если мозгов хватит 

Добавлено через 11 часов, 21 минуту и 9 секунд:

примерно так, но, скажу сразу, макрос не работает

Мне помогли, написали вот такой макрос, но он тоже не работает http://narod.ru/disk/14632215001/%D0%90%D0%90%D0%90.rar.html
Там нужно как я понял две базы одна в Exel, а другая в Access и ещё вставить кусок кода?

[rikomono]

Код:

Public Sub test()
    Dim w As Range
    Dim i As Integer
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    
    'открываем соединение к БД
    Set cn = New ADODB.Connection
    cn.ConnectionString = "тута строка подключения"
    
    'бежим по всем словам в тексте
    For i = 1 To ThisDocument.Words.Count
        'ищем слово в БД
        rs.Open cn, "select BBB from Таблица where AAA = '" + w.Text + "'"
        
        'Слово находящееся в ячейке поля "ВВВ"  справа от слова в поле "ААА" было помещено на слово в исходном тексте с помощью (PhoneticGuide
        If Not rs.EOF Then
            Set w = ThisDocument.Words.Item(i)
            If Asc(w.Text) > 30 Then w.PhoneticGuide Text:="qqq", Alignment:=wdPhoneticGuideAlignmentOneTwoOne, Raise:=14, FontSize:=10, FontName:="Lucida Sans Unicode"
        
        ' А если слова нет в базе данных, то слово в тексте заключалось  бы в такие скобки <слово>
        Else
             w.Text = "<" + w.Text + ">"
        End If
        rs.Close
    Next
    
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

Мне сказали, что в последнем куске кода не указана строка подключения к базе данных. А ещё для работоспособности указанного куска кода необходимо подключить к проекту VBA одну из версий библиотеки Microsoft ActiveX Data Objects. Определись, в каком формате база данных, где она находится (путь к файлу базы данных).

[RXL]

rikomono, сразу видно, что ты даже не прочитал, что тебе написали...

Код:

cn.ConnectionString = "тута строка подключения"

[rikomono]

rikomono, сразу видно, что ты даже не прочитал, что тебе написали...

Код:

cn.ConnectionString = "тута строка подключения"

Нет я прочитал вписал туда адрес базы. Вписывал туда адрес документа Ехеl затем вписывал адрес базы Access, так и так не работает. Вылетает ошибка (Compile error: User-defined type not defined)

(click to show)

Public Sub test()
    Dim w As Range
    Dim i As Integer
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
   
    'открываем соединение к БД
    Set cn = New ADODB.Connection
    cn.ConnectionString = "C:\DataB1.accdb"
   
    'бежим по всем словам в тексте
    For i = 1 To ThisDocument.Words.Count
        'ищем слово в БД
        rs.Open cn, "select BBB from Таблица where AAA = '" + w.Text + "'"
       
        'Слово находящееся в ячейке поля "ВВВ"  справа от слова в поле "ААА" было помещено на слово в исходном тексте с помощью (PhoneticGuide
        If Not rs.EOF Then
            Set w = ThisDocument.Words.Item(i)
            If Asc(w.Text) > 30 Then w.PhoneticGuide Text:="qqq", Alignment:=wdPhoneticGuideAlignmentOneTwoOne, Raise:=14, FontSize:=10, FontName:="Lucida Sans Unicode"
       
        ' А если слова нет в базе данных, то слово в тексте заключалось  бы в такие скобки <слово>
        Else
             w.Text = "<" + w.Text + ">"
        End If
        rs.Close
    Next
   
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

и пробовал вот так

(click to show)

Public Sub test()
    Dim w As Range
    Dim i As Integer
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
   
    'открываем соединение к БД
    Set cn = New ADODB.Connection
    cn.ConnectionString = "C:\AAA.xlsx"
   
    'бежим по всем словам в тексте
    For i = 1 To ThisDocument.Words.Count
        'ищем слово в БД
        rs.Open cn, "select BBB from Таблица where AAA = '" + w.Text + "'"
       
        'Слово находящееся в ячейке поля "ВВВ"  справа от слова в поле "ААА" было помещено на слово в исходном тексте с помощью (PhoneticGuide
        If Not rs.EOF Then
            Set w = ThisDocument.Words.Item(i)
            If Asc(w.Text) > 30 Then w.PhoneticGuide Text:="qqq", Alignment:=wdPhoneticGuideAlignmentOneTwoOne, Raise:=14, FontSize:=10, FontName:="Lucida Sans Unicode"
       
        ' А если слова нет в базе данных, то слово в тексте заключалось  бы в такие скобки <слово>
        Else
             w.Text = "<" + w.Text + ">"
        End If
        rs.Close
    Next
   
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

Добавлено через 41 минуту и 53 секунды:
Помогите, пожалуйста, очень нужен макрос, а я к сожалению плохо разбираюсь в VBA

[RXL]

Почитай вот это:
http://ru.wikipedia.org/wiki/%D0%A1%D1%82%D1%80%D0%BE%D0%BA%D0%B0_%D0%BF%D0%BE%D0%B4%D0%BA%D0%BB%D1%8E%D1%87%D0%B5%D0%BD%D0%B8%D1%8F

Потом сходи сюда: http://www.connectionstrings.com/

[rikomono]

Спасибо за информацию. Я почитал.
Там для подключения к Exel 2007 (ACE OLEDB 12.0) даны следующие варианты.

(click to show)

Connection strings for Excel 2007 (ACE OLEDB 12.0)
Type:    OLE DB Provider
Usage:  Provider=Microsoft.ACE.OLEDB.12.0

Xlsx files
This one is for connecting to Excel 2007 files with the Xlsx file extension. That is the Office Open XML format with macros disabled.

Код:

Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\myFolder\myExcel2007file.xlsx;Extended Properties="Excel 12.0 Xml;HDR=YES";

"HDR=Yes;" indicates that the first row contains columnnames, not data. "HDR=No;" indicates the opposite.

Treating data as text
Use this one when you want to treat all data in the file as text, overriding Excels column type "General" to guess what type of data is in the column.

Код:

Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\myFolder\myExcel2007file.xlsx;Extended Properties="Excel 12.0 Xml;HDR=YES;IMEX=1";

If you want to read the column headers into the result set (using HDR=NO even though there is a header) and the column data is numeric, use IMEX=1 to avoid crash.

To always use IMEX=1 is a safer way to retrieve data for mixed data columns. Consider the scenario that one Excel file might work fine cause that file's data causes the driver to guess one data type while another file, containing other data, causes the driver to guess another data type. This can cause your app to crash.

Xlsb files
This one is for connecting to Excel 2007 files with the Xlsb file extension. That is the Office Open XML format saved in a binary format. I e the structure is similar but it's not saved in a text readable format as the Xlsx files and can improve performance if the file contains a lot of data.

Код:

Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\myFolder\myBinaryExcel2007file.xlsb;Extended Properties="Excel 12.0;HDR=YES";

You can also use this connection string to connect to older 97-2003 Excel workbooks.

"HDR=Yes;" indicates that the first row contains columnnames, not data. "HDR=No;" indicates the opposite.
Xlsm files
This one is for connecting to Excel 2007 files with the Xlsm file extension. That is the Office Open XML format with macros enabled.

Код:

Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\myFolder\myExcel2007file.xlsm;Extended Properties="Excel 12.0 Macro;HDR=YES";

Important note!
The quota " in the string needs to be escaped using your language specific escape syntax.
c#, c++   \"
VB6, VBScript   ""
xml (web.config etc)   &quot;
or maybe use a single quota '.

"HDR=Yes;" indicates that the first row contains columnnames, not data. "HDR=No;" indicates the opposite.

Для моего случая наверно надо использовать первый вариант. Подскажите как правильно это сделать. Я пробовал у меня не получилось

[RXL]

1. MS Office 2007 у тебя стоит?
2. Что  не получилось? Код в студию!

[rikomono]

Да у меня MS Office 2007.
Вот код.

(click to show)

Public Sub test()
    Dim w As Range
    Dim i As Integer
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
   
    'открываем соединение к БД
    Set cn = New ADODB.Connection
    cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\AAA.xlsx;Extended Properties="Excel 12.0 Xml;HDR=YES";"
   
    'бежим по всем словам в тексте
    For i = 1 To ThisDocument.Words.Count
        'ищем слово в БД
        rs.Open cn, "select BBB from Таблица where AAA = '" + w.Text + "'"
       
        'Слово находящееся в ячейке поля "ВВВ"  справа от слова в поле "ААА" было помещено на слово в исходном тексте с помощью (PhoneticGuide
        If Not rs.EOF Then
            Set w = ThisDocument.Words.Item(i)
            If Asc(w.Text) > 30 Then w.PhoneticGuide Text:="qqq", Alignment:=wdPhoneticGuideAlignmentOneTwoOne, Raise:=14, FontSize:=10, FontName:="Lucida Sans Unicode"
       
        ' А если слова нет в базе данных, то слово в тексте заключалось  бы в такие скобки <слово>
        Else
             w.Text = "<" + w.Text + ">"
        End If
        rs.Close
    Next
   
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

И ещё наверно вот в  этом месте

Код:

If Asc(w.Text) > 30 Then w.PhoneticGuide Text:="qqq", Alignment:=wdPhoneticGuideAlignmentOneTwoOne, Raise:=14, FontSize:=10, FontName:="Lucida Sans Unicode"

Вместо "qqq" должно стоять " + w.Text + "  наверно?

[RXL]

Гадать лучше всего на кофейной гуще. И бубен нужен настоящий, шаманский.

Если пишешь на языке, то изучи сперва его синтаксис! Когда в текст нужно вставить двойную кавычку, ее следует удвоить.

Код: (Visual Basic)

x = "aaaa""bbbb"""

[rikomono]

Гадать лучше всего на кофейной гуще. И бубен нужен настоящий, шаманский.

Если пишешь на языке, то изучи сперва его синтаксис!

Я не гадаю на кофейной гуще, я просто не знаю VBA, но мне очень нужен этот макрос. Я для дочери делаю фонетическое руководство. Вот и пришёл на форум программистов за помощью.
Вот мне один хороший человек написал макрос он почти работает. А точнее он работает только если каждое слово на новой строке. Там он сказал происходит слияние двух баз затем разведка в базах что это оптимально потому что каждый раз не надо дёргать базы. При первом запросе надо открыть базу Exel при втором базу Access. http://narod.ru/disk/14767153001/%2B%2B%2B.rar.html
Мне действительно очень нужен этот макрос в нормальном рабочем состоянии, можно платно в разумных пределах.

[RXL]

rikomono, эх, вот воя строчка:

Код:

cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\AAA.xlsx;Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

Макрос твой хреновый и работать не будет. Тут еще горы несуразностей.

Код: (Visual Basic)

1. Public Sub test()
2.     Dim w As Range
3.     Dim i As Integer
4.     Dim cn As ADODB.Connection
5.     Dim rs As ADODB.Recordset
6.    
7.     'открываем соединение к БД
8.    Set cn = New ADODB.Connection
9.     cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\AAA.xlsx;Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
10.  
11.     Set rs = New ADODB.Recordset ' ------- Почему-то данной строчки не было.
12.  
13.     'бежим по всем словам в тексте
14.    For i = 1 To ThisDocument.Words.Count
15.         'ищем слово в БД  ------- Какое слово? Откуда оно взялось?
16.        rs.Open cn, "select BBB from Таблица where AAA = '" + w.Text + "'"
17.        
18.         'Слово находящееся в ячейке поля "ВВВ"  справа от слова в поле "ААА" было помещено на слово в исходном тексте с помощью (PhoneticGuide
19.        If Not rs.EOF Then
20.             Set w = ThisDocument.Words.Item(i)
21.             If Asc(w.Text) > 30 Then w.PhoneticGuide Text:=rs!BBB, Alignment:=wdPhoneticGuideAlignmentOneTwoOne, Raise:=14, FontSize:=10, FontName:="Lucida Sans Unicode"
22.        
23.         ' А если слова нет в базе данных, то слово в тексте заключалось  бы в такие скобки <слово>
24.        Else
25.              w.Text = "<" + w.Text + ">"
26.         End If
27.         rs.Close
28.     Next
29.    
30.     Set rs = Nothing
31.     cn.Close
32.     Set cn = Nothing

Строчку 20, полагаю, надо пеместить на 15-ю позицию.

[HandKot]

Строчку 20, полагаю, надо пеместить на 15-ю позицию.

это точно

скажу сразу, что не получилось
цикл зацикливался после команды PhoneticGuide (но лучше проверить)
возможно обойти эту проблему можно заменив

Код:

For i = 1 To ThisDocument.Words.Count

на обратный ход, но точной уверенности нет

[rikomono]

Макрос твой хреновый и работать не будет. Тут еще горы несуразностей.

Да Вы правы он не работает, но вот посмотрите вот этот он почти работает +++.rar,запустить макрос start при первом запросе надо открыть базу Exel при втором базу Access (он работает только если каждое слово на новой строке).

Как бы сделать так, чтобы макрос start производил операцию (PhoneticGuide) в обычном тексте, а не когда каждое слово на отдельной строке.

[RXL]

rikomono, трудно понять, читаешь ли ты, что мы тебе пишем.

Короче, вот, что коллективный разум предложил:

Код: (Visual Basic)

1. Public Sub test()
2.     Dim w As Range
3.     Dim i As Integer
4.     Dim cn As New ADODB.Connection
5.     Dim rs As New ADODB.Recordset
6.    
7.     cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\AAA.xlsx;Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
8.    
9.     'бежим по всем словам в тексте
10.    For i = ThisDocument.Words.Count To 1 Step -1
11.         Set w = ThisDocument.Words.Item(i)
12.         'ищем слово в БД
13.        rs.Open cn, "select BBB from Таблица where AAA = '" + w.Text + "'"
14.        
15.         'Слово находящееся в ячейке поля "ВВВ"  справа от слова в поле "ААА" было помещено на слово в исходном тексте с помощью PhoneticGuide
16.        If Not rs.EOF Then
17.             If Asc(w.Text) > 30 Then w.PhoneticGuide Text:=rs!BBB, Alignment:=wdPhoneticGuideAlignmentOneTwoOne, Raise:=14, FontSize:=10, FontName:="Lucida Sans Unicode"
18.        
19.         ' А если слова нет в базе данных, то слово в тексте заключалось  бы в такие скобки <слово>
20.        Else
21.              w.Text = "<" + w.Text + ">"
22.         End If
23.         rs.Close
24.     Next
25.    
26.     Set rs = Nothing
27.     cn.Close
28.     Set cn = Nothing
29. End Sub

Мне только не понятен смысл "Asc(w.Text) > 30" в строке 17.

[rikomono]

RXL, у меня вопрос, а макрос который Вы предложили у Вас работает?
У меня он не работает. Может я его как-то  не так запускаю или у меня чего нибудь не установлено?

[RXL]

Я его не проверял. Непонятное я указал постом выше - остальное очевидно.

[HandKot]

Мне только не понятен смысл "Asc(w.Text) > 30" в строке 17.

а это чтобы он не обрабатывал спец символы они вроде как отдельное слово или я что-то путаю

У меня он не работает

он работает, только что проверил, но надо доработать напильником

[Fedor]

Господа мне тоже нужен такой код!
Последний из предложенных выдаёт ошибку User-defined type not defined и показывает на "cn As New ADODB.Connection" из четвертой строки. Прошу не ругаться если вопрос глупый, как исправить? и как должен называться файл базы данных excel (это имя в коде указано?)?

[Dimka]

Fedor, надо подключить COM-объект. Как - не скажу, MSO давно уже под рукой нет.

[HandKot]

выдаёт ошибку User-defined type not defined и показывает на "cn As New ADODB.Connection" из четвертой строки.

либо подключите библиотеку Microsoft ActiveX Data Objects x.x  Library
либо замените эту строку на две

Код:

Dim cn As Object
Set cn = CreateObject("ADODB.Connection")