Option Explicit
' https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms723609(v=vs.85)
Const SAFT48kHz16BitStereo = 39
' Creates file even if file exists and so destroys or overwrites the existing file
Const SSFMCreateForWrite = 3
Dim oFileStream, oVoice
Dim message, mobilegaming
Dim MessageBox, Title, Default
MessageBox = "Enter your Text" ' Set prompt.
Title = "Text to Speech" ' Set title.
Default = "Привет, комрад! Как твои дела?" ' Codepage source - ANSI: CP1251
message = InputBox(MessageBox, Title, Default, 100, 100)
Set mobilegaming = CreateObject("SAPI.SpVoice")
mobilegaming.Speak message
Set oFileStream = CreateObject("SAPI.SpFileStream") ' Save Steam
oFileStream.Format.Type = SAFT48kHz16BitStereo
oFileStream.Open "C:\Users\User\Desktop\Output.mp3", SSFMCreateForWrite
Set oVoice = CreateObject("SAPI.SpVoice")
Set oVoice.AudioOutputStream = oFileStream
oVoice.Speak message
oFileStream.CloseLoop Until ('что-то' равно), или в начале указать условия выполнения цикла Do While ('пока соблюдается' условие). Блок-схемы помогают в таких вопросах.
Sub catch_error()
Dim curerr As Object
On Error Resume Next
Set curerr = Err
' Установить Adobe Acrobat, создать COM-объект
' Set objPDDoc = CreateObject("AcroExch.PDDoc")
' ...
End Subjso использовать для отладки консольjso.console.Show
jso.console.Clear
jso.console.println ("err!")Option Explicit
Const VERSION = "rev100"
Const VERSIONDATE = "17/10/2016"
Sub ProcessDir(folder)
Dim fname, file, subfolder, i
Const ForReading = 1
Const ForWriting = 2
Const xlOpenXMLWorkbook = 51
For Each file In folder.Files
If extold = LCase(fso.GetExtensionName(file)) Then
fname = file.Path
Set fl = fso.OpenTextFile(fname, ForReading, False)
txt = Split(fl.ReadAll(), vbCrLf)
For i = 0 To UBound(txt)
txt(i) = Replace(txt(i), ";", ",")
Next
fl.Close
file.Name = file.Name & "_bak"
Set fl = fso.CreateTextFile(fname, True)
fl.Write Join(txt, vbCrLf)
fl.Close
End If
Next
For Each file In folder.Files
If extold = LCase(fso.GetExtensionName(file)) Then
fname = file.Path
Set fl = CreateObject("Excel.Application")
' fl.Visible = True ' Debug
With fl.Workbooks.Open(fname)
' Do Something... '
.SaveAs Replace(fname, extold, extnew), xlOpenXMLWorkbook: .Close False
End With
fso.DeleteFile(Replace(fname, extold & "_bak", extold))
End If
Next
For Each file In folder.Files
If extold & "_bak"= LCase(fso.GetExtensionName(file)) Then
file.Name = Replace(file.Name, extold & "_bak", extold)
MsgBox "File " & file.Name & " successfully created.", vbInformation
End If
Next
For Each subfolder In folder.SubFolders
ProcessDir (subfolder)
Next
End Sub
Dim fso, folder, fl, txt
folder = "C:\Users\User\Desktop\"
' Change the extension in the program settings
Const extold = "csv"
' This extension can be written after changing semicolon to a comma
Const extnew = "xlsx"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folder)
ProcessDir (folder)
Set fso = NothingSelection. Код для VBA:Option Explicit
'123456789012345678901234567890123456h8nor@ya567890123456789012345678toster56789
Sub Replacement_tags()
Dim Content_Find As Find ' Объект Find (в VBScript переменные объявляются без указания типа)
Const wdFindContinue = 2 ' для VBScript
Const wdReplaceAll = 1 ' для VBScript
' Set objWrd = CreateObject("Word.Application") ' В MS Word объявлять не нужно
' в VBScript всё равно придётся открывать файл, так что objDoc = objWrd.ActiveDocument
' Set objDoc = objWrd.Documents.Open(Filename:="C:\FullName.doc")
Set Content_Find = ActiveDocument.Content.Find ' в VBScript - objDoc.Content.Find
With Content_Find ' Найти метку
.ClearFormatting: .Replacement.ClearFormatting ' Очистить формат
.MatchWildcards = False ' ВАЖНО! Отключить Подстановочные знаки
.Replacement.Font.Color = wdColorAutomatic ' wdColorAutomatic = -587137025
.Text = "p***p": .Replacement.Text = "newText"
.Execute2007 Forward:=True, Replace:=wdReplaceAll, Wrap:=wdFindContinue
End With
' Подсветить ".Text" в документе Word 2007+ (визуальная отладка)
With Content_Find ' Отменяется после метода "Execute" или "ClearHitHighlight"
.Parent.HomeKey wdStory ' wdStory = 6
.HitHighlight .Text, wdColorTan ' wdColorTan = &H99CCFF
End With
End Sub.Selection.EndKey не нужен, т.к. в вашем примере указана замена по всему тексту (.Replace = 1), а поиск начинается с позиции курсора, т.е. сначала. Цикла поиска по тексту нет, так что .Wrap можно не использовать.objWrd.ScreenUpdating = False.