Very old and not documented code
[blue]Main macro:[/blue]
Sub Flir92()
'
' Flir92 Macro
'
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim ColIndex, RowIndex, Done, EntryValue, test
Dim EntryString, AcqFile, AcqFileName, PauseTime, StartTime
Dim DwellPath, ExcelDwellPath, FileName, SheetName, Flir92File
Dim Comma, Quote, FileKey, KeyCol, KeyRow, ColMax, ColumnHead, TempFlag, Temp
Comma = ","
Quote = """"
Dim EnvString, Indx, Msg, PathLen, SysRoot, BatPath
SysRoot = Environ("SystemRoot") ' Get environment variable.
Dim WordApp As Word.Application
Dim AcqBook As Object
On Error Resume Next
If Tasks.Exists("Microsoft Word") Then Set WordApp = GetObject(, "word.application")
If WordApp = "" Then Set WordApp = CreateObject("word.application")
On Error GoTo 0
Err.Clear
WordApp.WindowState = wdWindowStateMinimize
WordApp.Visible = True
Application.DisplayAlerts = False
FileName = ActiveWorkbook.Name
SheetName = ActiveSheet.Name
Sheets("MRTSheet").Select
KeyRow = ActiveCell.Row
KeyCol = ActiveCell.Column
Cells(KeyRow, KeyCol).Select
Flir92File = Range("Flir92File").Value
ExcelDwellPath = ActiveWorkbook.Path & "\" & Flir92File
DwellPath = ExcelDwellPath
BatPath = ActiveWorkbook.Path
AcqFile = "Xl_acqmw2.xls"
AcqFileName = ActiveWorkbook.Path & "\" & AcqFile
Set AcqBook = GetObject(AcqFileName)
Sheets(SheetName).Select
Done = False
ColIndex = 1
RowIndex = ActiveCell.Row
Cells(RowIndex, ColIndex).Select
FileKey = ActiveCell.Value
ColumnHead = Range("field_temp").Value
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
While Not Done
If FileKey <> "" Then
Call OpenFlir92(WordApp, DwellPath)
Application.StatusBar = "Editing Input File..."
ColMax = Range("PerformanceOutput").Column - 2
TempFlag = False
For Column = ColIndex + 1 To ColIndex + ColMax
EntryValue = Cells(RowIndex, Column).Value
If EntryValue <> "" Then
If IsNumeric(EntryValue) Then
If EntryValue < 1000 Then
EntryValue = Application.WorksheetFunction.Text(EntryValue, "0.000")
Else
EntryValue = Application.WorksheetFunction.Text(EntryValue, "0.000E+00")
End If
End If
EntryString = Cells(3, Column).Value
If EntryString = ColumnHead Then
TempFlag = True
Temp = Cells(RowIndex, Column).Value
End If
Call ModFlir92(WordApp, EntryString, EntryValue)
End If
Next Column
Call CloseFlir92(WordApp)
Application.StatusBar = "Running Flir92..."
Application.DisplayAlerts = True
Nyquist = Range("Nyquist").Value
Call RunFlir92(BatPath, SysRoot, Flir92File, Nyquist)
Call GetFlir92MRT(WordApp, DwellPath)
Application.StatusBar = "Getting MRT..."
Windows(FileName).Activate
Sheets("MRTSheet").Select
ActiveCell.Value = FileKey
Cells(KeyRow + 1, KeyCol).Select
ActiveSheet.Paste
KeyCol = KeyCol + 2
If KeyCol > 250 Then
KeyCol = 1
KeyRow = KeyRow + 25
End If
Cells(KeyRow, KeyCol).Select
Windows(AcqFile).Activate
Sheets("Main Calculations").Select
Range("A12").Select
ActiveSheet.Paste
If TempFlag = True Then
Windows("LT7Dat1.xls").Activate
Select Case Int(Temp) ' Evaluate Number.
Case 244, 257
Range("Tran257").Select
Case 272
Range("Tran272").Select
Case 287
Range("Tran287").Select
Case 294
Range("Tran294").Select
Case 308
Range("Tran308").Select
Case 322
Range("Tran322").Select
End Select
Selection.Copy
Windows(AcqFile).Activate
Range("MLS23").Select
ActiveSheet.Paste
End If
Range("RangePerformance").Select
Selection.Copy
Windows(FileName).Activate
Sheets(SheetName).Select
Cells(RowIndex, Range("PerformanceOutput").Column).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Windows(AcqFile).Activate
Sheets("Main Calculations").Select
Range("OtherPerformance").Select
Selection.Copy
Windows(FileName).Activate
Sheets(SheetName).Select
Cells(RowIndex, Range("PerformanceOutput2").Column).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End If
RowIndex = RowIndex + 1
ColIndex = 1
Cells(RowIndex, ColIndex).Select
FileKey = ActiveCell.Value
If FileKey = "" Then Done = True
Wend
Application.DisplayAlerts = True
Application.StatusBar = ""
End Sub
[blue]Macro that edits text files in Word from Excel:[/blue]
Sub ModFlir92(WordApp, EntryString, EntryValue)
'
WordApp.Selection.Find.ClearFormatting
With WordApp.Selection.Find
.Text = EntryString
End With
WordApp.Selection.Find.Execute
WordApp.Selection.MoveRight unit:=wdCharacter, Count:=1
WordApp.Selection.Find.ClearFormatting
With WordApp.Selection.Find
.Text = "^#"
End With
WordApp.Selection.Find.Execute
WordApp.Selection.Find.ClearFormatting
WordApp.Selection.ExtendMode = True
With WordApp.Selection.Find
.Text = " "
End With
WordApp.Selection.Find.Execute
WordApp.Selection.MoveLeft unit:=wdCharacter, Count:=1, Extend:=wdExtend
WordApp.Selection.TypeText Text:=EntryValue
WordApp.Selection.HomeKey unit:=wdStory
End Sub
[blue]Macro that runs .bat file:[/blue]
Sub RunFlir92(BatPath, SysRoot, DwellPath, Nyquist)
Dim ShellPath, PauseTime, StartTime, EndTime, RunTime, TimerTemp
ChDir (BatPath)
If Dir(DwellPath & ".2") <> "" Then Kill (DwellPath & ".2") 'Deletes output file to make
'sure that there isn't a hangup from WORD
If Dir(DwellPath & ".trm") <> "" Then Kill (DwellPath & ".trm") 'Deletes flag file to make
'sure that there isn't a hangup
ShellPath = SysRoot & "\system32\zona.bat " & DwellPath & " " & Nyquist
RetVal = Shell(ShellPath, vbNormalFocus)
Do While Dir(DwellPath & ".trm") = ""
Loop
PauseTime = 2
StartTime = Timer
Do While Timer < StartTime + PauseTime
Loop
On Error GoTo KillTrm 'forces delete when permission denied error occurs
KillTrm:
If Dir(DwellPath & ".trm") <> "" Then Kill (DwellPath & ".trm") 'Deletes flag file to make
EndTime = Timer
RunTime = EndTime - StartTime
End Sub
[blue]Macro that retrieves data from output file in Word from Excel:[/blue]
Sub GetFlir92MRT(WordApp, DwellPath)
'
'
WordApp.Application.DisplayAlerts = False
WordApp.Documents.Open FileName:=DwellPath & ".2", PasswordTemplate:= _
"", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _
Format:=wdOpenFormatAuto, ReadOnly:=True
WordApp.Selection.EndKey unit:=wdStory
WordApp.Selection.HomeKey unit:=wdLine
WordApp.Selection.MoveUp unit:=wdLine, Count:=70, Extend:=wdExtend
' WordApp.Selection.MoveUp Unit:=wdLine, Count:=21, Extend:=wdExtend
Call MakeTable(WordApp)
WordApp.Selection.MoveDown unit:=wdLine
WordApp.Selection.MoveDown unit:=wdLine, Count:=20, Extend:=wdExtend
WordApp.Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=10, _
NumRows:=20
WordApp.Selection.HomeKey unit:=wdLine
WordApp.Selection.MoveRight unit:=wdCell
WordApp.Selection.MoveRight unit:=wdWord, Count:=2, Extend:=wdExtend
WordApp.Selection.MoveDown unit:=wdLine, Count:=19, Extend:=wdExtend
WordApp.Selection.Copy
WordApp.ActiveDocument.Close (wdDoNotSaveChanges)
End Sub
[blue].bat file that runs program and creates dummy file when program completes:[/blue]
d:\memo\c995\cobra\flir92 -d %1 -o %1 -p MRT -nyq %2
rem pause
copy %1 %1.trm
TTFN