Dim AppWord As Word.Application
Dim AppExcel As Excel.Application
Private Sub CommandButton4_Click()
Dim tmpText As String
Dim Msg As String, thisMonth As String, thisMonthYr As String
Dim s As Integer, i As Integer, j As Integer
'Process into Arrays
Dim file As file
Dim fld As Folder
Dim fso As New FileSystemObject
Dim SummarySize As Integer, DetailSize As Integer
Dim inputFiles_s() As String, inputFiles_d() As String
Dim outputFiles_s() As String, outputFiles_d() As String
Const DEFAULT_FILE_PATH As String = "C:\Sin\MMMYYYY\Source"
SummarySize = 0
DetailSize = 0
thisMonth = "_" & Format(DateAdd("m", -1, Date), "mmm") & "_"
If fso.FolderExists(DEFAULT_FILE_PATH) Then
Set fld = fso.GetFolder(DEFA
ULT_FILE_PATH)
For Each file In fld.Files
If InStr(UCase(file.Name), "MMM") > 0 Then
If InStr(UCase(file.Name), "SUMMARY") > 0 Then
If InStr(file, "MMM") > 0 And InStr(file, ".txt") > 0 Then
SummarySize = SummarySize + 1
ReDim Preserve inputFiles_s(SummarySize)
ReDim Preserve outputFiles_s(SummarySize)
inputFiles_s(SummarySize) = file
'MsgBox (file.Name)
outputFiles_s(SummarySize) = Replace(outputFiles_s(SummarySize), ".txt", ".doc")
outputFiles_s(SummarySize) = Replace(outputFiles_s(SummarySize), "_MMM_", thisMonth)
'MsgBox (outputFiles_s(SummarySize))
End If
End If
If InStr(UCase(file.Name), "DETAIL") > 0 Then
If InStr(file, "_MMM_") > 0 And InStr(file, ".txt") > 0 Then
DetailSize = DetailSize + 1
ReDim Preserve inputFiles_d(DetailSize)
ReDim Preserve outputFiles_d(DetailSize)
inputFiles_d(DetailSize) = file
'MsgBox (file.Name)
outputFiles_d(DetailSize) = Replace(inputFiles_d(DetailSize), "_MMM_", thisMonth)
outputFiles_d(DetailSize) = Replace(outputFiles_d(DetailSize), ".txt", ".doc")
'MsgBox (outputFiles_d(DetailSize))
End If
End If
End If
Next file
End If
'End process into arrays
'This loop is for the summary Files
For i = 1 To SummarySize
On Error GoTo error
If Not IsEmpty(inputFiles_s(i)) Then
Documents.Open inputFiles_s(i)
With ActiveDocument
.PageSetup.Orientation = wdOrientLandscape
If .Sentences.Count = 1 Then
.Sentences(1).ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.InsertAfter " " & vbCr
.Range.InsertAfter "Period: " & vbCr
.Range.InsertAfter "Report Date: " & vbCr
.Range.InsertAfter "Device Name,Event Summary,Outages,Total Down Time (Days:Hours:Minutes),Reason" & vbCr
.Range.InsertAfter "N/A,N/A,N/A,N/A"
Set ToConvert = .Range(Start:=.Sentences(4).Start)
ToConvert.ConvertToTable Separator:=wdSeparateByCommas
Else
Set FirstThree = .Range(Start:=.Sentences(1).Start, End:=.Sentences(3).End)
FirstThree.ParagraphFormat.Alignment = wdAlignParagraphCenter
s = .Sentences.Count - 1
Set RemainingText = .Range(Start:=.Sentences(4).Start, End:=.Sentences(s).End)
RemainingText.ConvertToTable Separator:=wdSeparateByCommas
insertHeader
CenterCols
insertFooter
repeatHeader
End If
.SaveAs FileName:=inputFiles_s(i), FileFormat:=wdFormatDocument
.OnTime When:=Now, Name:="CloseDocument"
.Close
End With
End If
error:
Next i
'End of loop for summary files
'This second loop is for the Detailed Files
For j = 1 To DetailSize
If Not IsEmpty(inputFiles_d(j)) Then
Documents.Open inputFiles_d(j)
With ActiveDocument
.PageSetup.Orientation = wdOrientLandscape
If .Sentences.Count = 1 Then
.Sentences(1).ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.InsertAfter " " & vbCr
.Range.InsertAfter "Period: " & vbCr
.Range.InsertAfter "Report Date: " & vbCr
.Range.InsertAfter "Device Name,Event Details,Polls Missed,DownTime DD:HH:MM,Reason" & vbCr
.Range.InsertAfter "N/A,N/A,N/A,N/A"
Set ToConvert = .Range(Start:=.Sentences(4).Start)
ToConvert.ConvertToTable Separator:=wdSeparateByCommas
Else
Set FirstThree = .Range(Start:=.Sentences(1).Start, End:=.Sentences(3).End)
FirstThree.ParagraphFormat.Alignment = wdAlignParagraphCenter
Set RemainingText = .Range(Start:=.Sentences(4).Start)
RemainingText.ConvertToTable Separator:=wdSeparateByCommas
insertHeader
CenterCols
insertFooter
repeatHeader
End If
.SaveAs FileName:=outputFiles_d(j), FileFormat:=wdFormatDocument
.OnTime When:=Now, Name:="CloseDocument"
.Close
End With
End If
Next j
'End of loop for Detailed Files
End Sub
Private Sub CommandButton5_Click()
End
End Sub
Private Sub insertHeader()
Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
Selection.Copy
Selection.Cut
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Paste
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
Sub repeatHeader()
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=36
Selection.MoveRight Unit:=wdCharacter, Count:=21, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=3, Extend:=wdExtend
Selection.MoveUp Unit:=wdLine, Count:=2, Extend:=wdExtend
Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
Selection.Rows.HeadingFormat = True <------- THIS PART IS HIGHTLIGHTED WHEN I PRESS DEBUG BUTTON (runtime error 5941)
End Sub
Sub insertFooter()
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.MoveDown Unit:=wdLine, Count:=4
NormalTemplate.AutoTextEntries("Page X of Y").Insert Where:=Selection. _
Range
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
ActiveWindow.ActivePane.VerticalPercentScrolled = 0
End Sub
Sub CenterCols()
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.SelectColumn <------- THIS PART IS HIGHTLIGHTED WHEN I PRESS DEBUG BUTTON (runtime error 4605)
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.MoveUp Unit:=wdLine, Count:=1
End Sub
