VBA code to read a word doc - vba

Is there any way to create a VBA code to read a word document via audio? as if the computer was reading the whatever is on the document. (of course all text).

I found this searching on google. http://vbadud.blogspot.com/2010/06/vba-how-to-convert-text-file-to-speech.html
Sub Speech_FromFile_Example()
Dim oVoice As SpVoice
Voice Object Dim oVoiceFile As SpFileStream
File Stream Object Dim sFile As String
File Name Set oVoice = New SpVoice
Set oVoiceFile = New SpFileStream
oVoice.Speak "This is an example for reading out a file"
sFile = "C:\ShasurData\ForBlogger\SpeechSample.txt"
oVoiceFile.Open sFile
oVoice.SpeakStream oVoiceFile
End Sub
The code requires Microsoft Speech Object Library
VBA macro for Word:
Dim speech as SpVoice
Sub SpeakText()
On Error Resume Next
Set speech = New SpVoice
If Len(Selection.Text) > 1 Then 'speak selection
speech.Speak Selection.Text
SVSFlagsAsync + SVSFPurgeBeforeSpeak
Else 'speak whole document
speech.Speak ActiveDocument.Range(0, ActiveDocument.Characters.Count).Text
SVSFlagsAsync + SVSFPurgeBeforeSpeak
End If
Do
DoEvents
Loop Until speech.WaitUntilDone(10)
Set speech = Nothing
End Sub
Sub StopSpeaking()
'Based on a macro by Mathew Heikkila
'used to interrupt any running speech to text
On Error Resume Next
speech.Speak vbNullString, SVSFPurgeBeforeSpeak
Set speech = Nothing
End Sub

Be careful if you are using Windows 10 - I had two libraries with the same name "Microsoft Speech Object Library" - make sure you select the one which points to Windows/system32/Speech/Common/sapi.dll

Related

How to search and replace across multiple word documents in the same folder?

I've tried to use the below code which I found on this conversation How To Search And Replace Across Multiple Files In Word? supplied by Charles Kenyon. However, it doesn't seem to work for me. I've enabled macros on my word and added the below code as a new module in Macros. When I go to replace all, it'll replace the text as per normal, but after doing this, when I open up the other macros enabled word doc, I find that the same text is still in these docs, without being replaced. Am I doing something wrong? Namely, I also wish to add a wildcard entry into my replace all, will the below code work or can someone suggest a better alternative? I have tested the below code with and without wildcard entries to no avail. I've also tried the code on this page in my macros but it also didn't work How to find and replace a text in multiple Word documents using VBAThanks for any help!
Option Explicit
Public Sub BatchReplaceAll()
Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long
PathToUse = "C:\Test\"
'Error handler to handle error generated whenever
'the FindReplace dialog is closed
On Error Resume Next
'Close all open documents before beginning
Documents.Close SaveChanges:=wdPromptToSaveChanges
'Boolean expression to test whether first loop
'This is used so that the FindReplace dialog will
'only be displayed for the first document
FirstLoop = True
'Set the directory and type of file to batch process
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
'Open document
Set myDoc = Documents.Open(PathToUse & myFile)
If FirstLoop Then
'Display dialog on first loop only
Dialogs(wdDialogEditReplace).Show
FirstLoop = False
Response = MsgBox("Do you want to process " & _
"the rest of the files in this folder", vbYesNo)
If Response = vbNo Then Exit Sub
Else
'On subsequent loops (files), a ReplaceAll is
'executed with the original settings and without
'displaying the dialog box again
With Dialogs(wdDialogEditReplace)
.ReplaceAll = 1
.Execute
End With
End If
'Close the modified document after saving changes
myDoc.Close SaveChanges:=wdSaveChanges
'Next file in folder
myFile = Dir$()
Wend
End Sub

Is there any method equivalent for "FollowHyperlink" in Outlook VBA?

Is there any method in Outlook VBA equivalent to Excel's FollowHyperlink?
I made an Excel VBA macro that posts the text in the clipboard to a specific site using FollowHyperlink method.
I want to do the same thing with Outlook VBA but I couldn't find the method.
Any method that does the same thing as simply as FollowHyperlink is quite fine.
Here is the Excel VBA version of a function that post the content of the clipboard to Google translation. I want to make an Outlook version of this one.
Public Sub GoogleTranslate_2EN()
Dim clipBoard As New DataObject
With clipBoard
On Error Resume Next
.GetFromClipboard
Dim targetText As String
targetText = .GetText
On Error GoTo 0
End With
Dim URL As String
URL = "https://translate.google.co.jp/?hl=en&tab=wT#auto/en/" & targetText
ThisWorkbook.FollowHyperlink Address:=URL, newWindow:=False, AddHistory:=True
End Sub
I've decided to use Word.Application object and use "FollowHyperlink" from a Word object. It worked!
Now I can Google translate emails in Germany to English as soon as I receive them. :-)
Public Sub ClipboardGoogleTranslate_2EN()
Dim wdApp As Word.Application
Set wdApp = CreateObject("Word.Application")
wdApp.Run "ClipboardGoogleTranslate_2EN"
wdApp.Quit
Set wdApp = Nothing
End Sub

Run Time Error Generated when opening Microsoft Word Document from Excel VBA

Receiving a Runtime Error '13' exception when creating a word application object. I also was experiencing relatively extreme delays (on the order of 20-30 seconds) of running prior to the exception. Any idea what this could be from? I searched Stackoverflow and I haven't seen anything that was very similar.
I have never worked with an word doc from excel before so this is something new to me.
Code Below:
Public Sub GetRawData()
'Meant to translate data from a raw word file and format into excel
Dim filePath As String
Dim objWord As Application
Set objWord = CreateObject("Word.Application")
Dim objDoc As Word.Document
'File management vars
Dim oneLine As Paragraph
Dim lineText As String
filePath = "U:\Research_Dev Docs\DevFolder\Word Doc Translation In Excel For Phys\testWordDoc.docx"
'Set word doc object using standard file directory and file name
Set objDoc = objWord.Documents.Open(Filename:=filePath, Visible:=True)
For Each oneLine In objDoc.Paragraphs
'Pull in each line and eventually parse
lineText = oneLine.Range.Text
'DEBUG OUTPUT TO THE SCREEN FOR TESTING
MsgBox (lineText)
Next oneLine
End Sub

MS Word's grammar checker launches with VBA delete all line breaks in MS Access form

I have this code in VBA which launches MS Word spelling and grammar checker after I exit text box of a ms Access form.
After the check is run, and the text sent back to the form, all the line breaks of my text are gone. My data look like a single paragraph instead of having nice formatting.
This happen on the Access side as the .doc that I see just at the end of the spelling check still has the line breaks.
Thanks a lot for your help!
Option Compare Database
Private Sub Description_Exit(Cancel As Integer)
Call SpellIt(Description)
End Sub
Public Function SpellIt(ctrl As Control)
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
On Error GoTo SpellIt_Err
Set wdApp = New Word.Application
wdApp.Visible = True
wdApp.Activate
If Not IsNull(ctrl) Then
Set wdDoc = wdApp.Documents.Add
wdApp.Selection.Text = ctrl
wdApp.Dialogs(wdDialogToolsSpellingAndGrammar).Show
If Len(wdApp.Selection.Text) <> 1 Then
ctrl = wdApp.Selection.Text
Else
wdDoc.Close wdDoNotSaveChanges
wdApp.Quit
Set wdApp = Nothing
Exit Function
End If
wdDoc.Close wdDoNotSaveChanges
End If
wdApp.Quit
Set wdApp = Nothing
MsgBox "Spelling and Grammar Check Complete.", vbInformation, "Microsoft Word Spelling And Grammar:"
Exit Function
SpellIt_Err:
Err.Clear
ctrl.Undo
MsgBox "We encountered an error in it's conversation with Microsoft Word regarding your comment." & vbCrLf & _
"As a precaution, any changes made within the grammar and spelling dialog box have not been retained.", _
vbCritical, "Spelling and Grammar Check NOT Complete:"
End Function
Looks like MS Word is using different linebreak characters than Access textbox controls. You can revert the characters back to their original used in Access after spellcheck by replacing this line:
ctrl = wdApp.Selection.Text
with:
ctrl = Replace(wdApp.Selection.Text, vbCr, vbCrLf)

Searching Heading Styles in VB6 for Unique String

I'm a third year software design student. I'm currently in the middle of my work placement. I had been asked to create a tool to parse word documents for relevant tabular data and export it to ms excel. I had never had any dealings with VB but based on the research I carried out I decided that was the route to take. Anyway I managed to execute this successfully. Now, however, I have been asked to expand the program to parse paragraphs also. The documents are broken down into chapters. Each chapter heading is in 'h2' style, my idea is to try to search all text in 'h2' style for a unique string and if found, which should be the required heading, then process the text underneath.
Can this be done?? If so, can you please let me know how, this has been a steep learning curve, and I was delighted with what I had achieved, now, I'm stuck dead. I have the methodology, it's finding the correct way to implement it. This will also allow me to create a search form which I intend to integrate to allow the user search for the chapter they want to parse...
If anyone can help me get out of this hole I would greatly appreciate it.
Take your Pick
VBA WORD CODE (Place this in a module)
Option Explicit
Sub VBASample()
Dim para As Paragraph
Dim strParaText As String
Dim searchString As String
searchString = "Sample"
For Each para In ActiveDocument.Paragraphs
If para.Style = "Heading 2" Then
strParaText = para.Range.Text
If InStr(1, strParaText, searchString, vbTextCompare) Then
'~~> You code here if the text is found
MsgBox "Found"
End If
End If
Next para
End Sub
VB6 CODE
Option Explicit
'~~> Using Late Binding so no reference to Word object is required.
Sub VB6Sample()
Dim oWordApp As Object, oWordDoc As Object, oWordPara As Object
Dim FlName As String, strParaText As String, searchString As String
'~> File Name where you want to check the paragraphs
FlName = "C:\Documents and Settings\Siddharth Rout\Desktop\Sample.doc"
'~~> Establish an Word application object
On Error Resume Next
Set oWordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0
oWordApp.Visible = True
Set oWordDoc = oWordApp.Documents.Open(FlName)
'~~> String that you want to search
searchString = "Sample"
For Each oWordPara In oWordDoc.Paragraphs
If oWordPara.Style = "Heading 2" Then
strParaText = oWordPara.Range.Text
If InStr(1, strParaText, searchString, vbTextCompare) Then
'~~> You code here if the text is found
MsgBox "Found"
End If
End If
Next oWordPara
End Sub