Converting DOS encoded text files to MS Word



Hi ALL,

i wrote a small VB6 example from scratch that handles the
conversion from DOS_ENCODED_OEM files to WORD DOCuments.

It converts those files without any user attention and can be used
in batch files.

You need Visual Basic 6 to create the executable.
(if someone is interested i can mail it)

This needs WORD97 as minimum

Perhaps it's useful for you, too.

RON, can you reproduce this example in xHB ?

I gave up on it.

Markus



Attribute VB_Name = "word1_main"
Option Explicit

Private Const Modul_Name = "word_main"


Sub Main()


Dim Source_File As String Dim Destination_File As String

    Source_File = before(Behind(UCase(Command$), "SOURCE="), " ")
    Destination_File = before(Behind(UCase(Command$), "DESTINATION="), " ")

    Call word_convert(Source_File, Destination_File)

End Sub



Function word_convert(Source_File As String, Destination_File As
String) As Long
Dim oword
Dim oText
Dim wdOpenFormatEncodedText As Long
Dim msoEncodingOEMMultilingualLatinI As Long
Dim WdSaveFormat As Long

wdOpenFormatEncodedText = 5
msoEncodingOEMMultilingualLatinI = 850
WdSaveFormat = 0

Set oword = CreateObject("Word.Application")


oword.Visible = False


oword.documents.Open FileName:=Source_File, _ Format:=wdOpenFormatEncodedText, _ Encoding:=msoEncodingOEMMultilingualLatinI


oword.Selection.WholeStory


With oword.Selection .Font.Name = "Courier New" .Font.Size = 9 .Font.Bold = False End With


With oword.Selection.PageSetup .PaperSize = 7 .Orientation = 0 .LeftMargin = oword.CentimetersToPoints(1.25) .RightMargin = oword.CentimetersToPoints(1.25) .TopMargin = oword.CentimetersToPoints(1.76) .BottomMargin = oword.CentimetersToPoints(1.76) End With



oword.DisplayAlerts = False


oword.ActiveDocument.SaveAs FileName:=Destination_File, _ FileFormat:=WdSaveFormat


oword.ActiveDocument.Close oword.quit

word_convert = 0

End Function



Function before$(ByVal Lang As String, ByVal trenner As String)
    Dim ret As String, idx As Long
    idx = InStr(Lang, trenner)
    Select Case idx
    Case 0
        ret = Lang
    Case 1
        ret = ""
    Case Else
        ret = Left$(Lang, idx - 1)
    End Select
    before$ = ret
End Function


Function Behind$(ByVal Lang As String, ByVal trenner As String) Dim idx As Long idx = InStr(Lang, trenner) Select Case idx Case 0 Behind$ = "" Case Else Behind$ = RTrim(Mid$(Lang + " ", idx + Len(trenner))) End Select End Function

--
Erstellt mit Operas revolutionärem E-Mail-Modul: http://www.opera.com/mail/
.



Relevant Pages

  • A Class to get the name of Enum constant at runtime
    ... Dim rs As ADODB.Recordset ... You can get the description of an Enum form it's value. ... EnumName As String, ... Dim Idx As Long ...
    (microsoft.public.vb.general.discussion)
  • RE: VB & Common Dialog???
    ... lpstrCustomFilter As String ... Private Declare Function SHGetPathFromIDList Lib "shell32" _ ... Dim sBuffer As String ... Dim Idx As Long ...
    (microsoft.public.vb.general.discussion)
  • Re: Unique Key Generation
    ... Private Function NumTo94As String ... Static bHere As Boolean ... Dim Idx As Long ... Dim Char As Long ...
    (microsoft.public.vb.general.discussion)
  • Re: Math with letters
    ... Public Shared Readonly A As New KeyValuePair(Of String, Integer) ... ByVal FieldName As String) As ReturnType ... Dim ret As ReturnType = Nothing ... If Not val Is Nothing Then ret = DirectCast ...
    (microsoft.public.dotnet.languages.vb)
  • Re: DIR-Funktion mit Systemvariablen
    ... Public Function ExpandEnvString(EnvString As String) As String ... Dim Ret As Long ... Dim NumChar As Long ...
    (microsoft.public.de.vb)