Results 1 to 4 of 4
  1. #1
    Star Lounger
    Join Date
    Nov 2003
    Posts
    61
    Thanks
    7
    Thanked 0 Times in 0 Posts

    WordBasic to VBA 6.3 translations (VBA 6.3)

    I have some old macro code in WordBasic that I'm having difficulty translating to VBA 6.3 . I've tried rewriting variables, etc. but it won't work for me. What it does is to grab a folder full of files and checks with the operator to make sure that it has the correct files and then removes Read Only attributes if it finds them, calls a subroutine that applies styles (which runs). It is part of a much larger macro.

    ----------

    Dim FileList__$(0), Variable

    Rem Obtains files for processing

    On Error Resume Next
    GetDirectory:

    Rem Get the Directory to Process

    Begin Dialog UserDialog 404, 114, "What Directory"
    Text 30, 10, 330, 26, "Please enter the Directory Path where the files you want to process are located.", .Text1
    TextBox 30, 39, 350, 18, .textbox1
    OKButton 100, 70, 90, 21
    CancelButton 210, 70, 90, 21
    End Dialog
    Dim dlg As UserDialog
    go = Dialog(dlg, -1)
    On Error GoTo 0
    If go = 0 Then GoTo EndProgram
    If dlg.textbox1 = "" Then GoTo GetDirectory
    DirName$ = LTrim$(dlg.textbox1)
    dirNum = CountDirectories(DirName$)
    If dirNum < 0 Then
    MsgBox "Can't Find " + DirName$ + Chr$(13) + "Halting Program!",
    "Game Over Player One!", 16
    GoTo EndProgram
    End If

    Rem Save Current Directory to return to later, then move Default
    Rem Directory to be equal to specified directory

    StartingDir$ = Files$(".")
    ChDir DirName$

    Rem Place filenames found in current directory in the FileList$ Arrary

    Temp$ = Files$("*.*")
    Count = -1
    While Temp$ <> ""
    Count = Count + 1
    Temp$ = Files$()
    Wend
    If Count > -1 Then
    Dim FileList$(Count)
    FileList$(0) = Files$("*.*")
    For i = 1 To Count
    FileList$(i) = Files$()
    Next i
    SortArray FileList$()
    Else
    MsgBox "There are no files in that folder!"
    GoTo EndProgram
    End If

    Rem Confirm Directory and Files before Processing

    On Error Resume Next
    Begin Dialog UserDialog 376, 236, "Check Before Processing"
    ListBox 20, 30, 333, 130, FileList$(), .listbox1
    Text 20, 10, 191, 13, "Found the following files:", .Text1
    PushButton 75, 190, 90, 21, "OK", .Push1
    CancelButton 195, 190, 90, 21
    Text 110, 167, 131, 13, "O.K. to proceed?", .Text3
    End Dialog
    Dim dlg As UserDialog
    proceed = Dialog(dlg, -1)
    test = dlg.listbox1
    On Error GoTo 0
    If proceed < 1 Then GoTo EndProgram


    Rem Remove Read Only Attribute From Original Files
    For i = 1 To Count
    attribs = GetAttr(FileList$(i))
    If attribs Mod 2 Then
    SetAttr FileList$(i), 0
    End If
    Next i

    Rem Get Style information
    Call GetStyle FileList$(0)

    Rem Process all the files in the Directory
    For loop = 0 To count
    Call Document FileList$(loop)
    Next loop

    EndProgram:
    If StartingDir$ <> "" Then ChDir StartingDir$

    If ScreenUpdating() = 0 Then ScreenUpdating
    For x = 1 To 25
    Beep -1
    For Y = 1 To 150
    Next Y
    Next x

    MsgBox "I'm Done With This Batch!", "Finito", 48
    End Sub

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: WordBasic to VBA 6.3 translations (VBA 6.3)

    In which version(s) of Word will the modified version be used?

  3. #3
    Star Lounger
    Join Date
    Nov 2003
    Posts
    61
    Thanks
    7
    Thanked 0 Times in 0 Posts

    Re: WordBasic to VBA 6.3 translations (VBA 6.3)

    The original started out in Word 7.0. This will be used in Word 2003.

    The larger macro takes a Word file, breaks it down into separate text and footnote files, and applies markup codes.

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: WordBasic to VBA 6.3 translations (VBA 6.3)

    Here is a "modernized" version. You may have to modify GetStyle to run - without knowing the code for it, it's impossible to tell.

    Sub ProcessFiles()
    Dim strFolder As String
    Dim strFile As String
    Dim intAttr As Integer

    ' Show file picker
    With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Pick any file in the folder you want to process."
    If .Show = True Then
    strFolder = .SelectedItems(1)
    Else
    Beep
    Exit Sub
    End If
    End With

    ' Extract folder path
    strFolder = Left(strFolder, InStrRev(strFolder, ""))

    strFile = Dir(strFolder & "*.doc")
    Do While Not strFile = ""
    strFile = strFolder & strFile
    ' Remove read only attribute
    intAttr = GetAttr(strFile)
    If intAttr And vbReadOnly Then
    SetAttr strFile, intAttr - vbReadOnly
    End If
    ' Do something with the file
    Call GetStyle(strFile)
    ' And on to the next
    strFile = Dir
    Loop
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •