Macro Runs and Opens Windows Calculator

Hi,

Somewhere in your code is something like the following...

Shell "calc.exe"1

This line will call the calculator. Delete it and you should be fine.

HTH,
Jay

Here is the code. I know it is very crude and I didn't use high levels of abstraction and I could/should have. But this works fine except for that one calculator glitch. Sub PopulateWebPage()
' this program will use the Master Data worksheet to populate part # pages

' creating variables
Dim counter As Integer
counter = 2
Dim partnum As Long
partnum = 0
Dim pagepopulated As Boolean
pagepopulated = False
Dim publishend As Boolean
publishend = False
Dim srrx As Integer
srrx = 0
Dim srry As Integer
srry = 0
Dim srrz As Integer
srrz = 0
Dim kxfill As Integer
kxfill = 0
Dim kyfill As Integer
kyfill = 0
Dim kzfill As Integer
kzfill = 0
Dim preloadfill As String
preloadfill = unknown
Dim massfill As Integer
massfill = 0
Dim fill As String
fill = unknown
Dim supplierfill As String
supplierfill = unknown
Dim packagel As String
packagel = unknown
Dim packagew As String
packagew = unknown
Dim packageh As String
packageh = unknown
Dim savename As String
savename = unknown
Dim foldername As String
foldername = unknown
Dim appWD As Word.Application
Dim folderexist As Boolean
folderexist = True
Dim foldercount As Integer
foldercount = 1
Dim errornum As Integer
errornum = 1

'begin the copy and past sequence
Do
saveStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Working on webpage for the part in row " & counter
If Sheets("Master Data").Range("A" & counter) & Sheets("Master Data").Range("B" & counter) & Sheets("Master Data").Range("C" & counter) & Sheets("Master Data").Range("D" & counter) = ISBLANK Then
publishend = True
' determining whether we are at the end of the excel sheet
' this would happen when the first four columns are empty
Else
If Sheets("Master Data").Range("AL" & counter).Value = True Or Sheets("Master Data").Range("AL" & counter).Value = "See Part Above" Then
counter = counter + 1
' Checking to see if the page has already been populated
' Set this column to "False" boolean if you want the page to be created again
ElseIf Sheets("Master Data").Range("A" & counter).Value = Sheets("Master Data").Range("A" & (counter - 1)) Then
Sheets("Master Data").Range("AL" & counter).Value = "See Part Above"
counter = counter + 1
Else
' filling in bom variant information
partnum = Sheets("Master Data").Range("A" & counter).Value
srrx = Sheets("Master Data").Range("AM" & counter).Value
srry = Sheets("Master Data").Range("AN" & counter).Value
srrz = Sheets("Master Data").Range("AO" & counter).Value
kxfill = Sheets("Master Data").Range("R" & counter).Value
kyfill = Sheets("Master Data").Range("S" & counter).Value
kzfill = Sheets("Master Data").Range("T" & counter).Value
preloadfill = Sheets("Master Data").Range("V" & counter).Value
massfill = Sheets("Master Data").Range("Q" & counter).Value
fill = Sheets("Master Data").Range("X" & counter).Value
supplierfill = Sheets("Master Data").Range("Y" & counter).Value
packagel = Sheets("Master Data").Range("Z" & counter).Value
packagew = Sheets("Master Data").Range("AA" & counter).Value
packageh = Sheets("Master Data").Range("AB" & counter).Value

' opens and activates microsoft word

Set appWD = CreateObject("Word.Application.8")
appWD.Visible = True
'opens template file to editpath is set to defaultif folder movesneed to change path


appWD.Documents.Open filename:="D:2002 Summer Intern ProjectWebPage_Version2templatesPart.dwt"ConfirmConversions:=FalseReadOnly:= _
FalseAddToRecentFiles:=FalsePasswordDocument:=""PasswordTemplate:= _
""Revert:=FalseWritePasswordDocument:=""WritePasswordTemplate:=""_
Format:=wdOpenFormatAuto

appWD.Selection.Find.ClearFormatting
appWD.Selection.Find.Replacement.ClearFormatting
With appWD.Selection.Find
.Text = "partnum"
.Replacement.Text = partnum
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
appWD.Selection.Find.Execute Replace:=wdReplaceAll

appWD.Selection.Find.ClearFormatting
appWD.Selection.Find.Replacement.ClearFormatting
With appWD.Selection.Find
.Text = "srrx"
.Replacement.Text = srrx
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
appWD.Selection.Find.Execute Replace:=wdReplaceAll

appWD.Selection.Find.ClearFormatting
appWD.Selection.Find.Replacement.ClearFormatting
With appWD.Selection.Find
.Text = "srry"
.Replacement.Text = srry
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
appWD.Selection.Find.Execute Replace:=wdReplaceAll

appWD.Selection.Find.ClearFormatting
appWD.Selection.Find.Replacement.ClearFormatting
With appWD.Selection.Find
.Text = "srrz"
.Replacement.Text = srrz
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
appWD.Selection.Find.Execute Replace:=wdReplaceAll

appWD.Selection.Find.ClearFormatting
appWD.Selection.Find.Replacement.ClearFormatting
With appWD.Selection.Find
.Text = "kxfill"
.Replacement.Text = kxfill
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
appWD.Selection.Find.Execute Replace:=wdReplaceAll

appWD.Selection.Find.ClearFormatting
appWD.Selection.Find.Replacement.ClearFormatting
With appWD.Selection.Find
.Text = "kyfill"
.Replacement.Text = kyfill
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
appWD.Selection.Find.Execute Replace:=wdReplaceAll

appWD.Selection.Find.ClearFormatting
appWD.Selection.Find.Replacement.ClearFormatting
With appWD.Selection.Find
.Text = "kzfill"
.Replacement.Text = kzfill
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
appWD.Selection.Find.Execute Replace:=wdReplaceAll

appWD.Selection.Find.ClearFormatting
appWD.Selection.Find.Replacement.ClearFormatting
With appWD.Selection.Find
.Text = "preloadfill"
.Replacement.Text = preloadfill
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
appWD.Selection.Find.Execute Replace:=wdReplaceAll

appWD.Selection.Find.ClearFormatting
appWD.Selection.Find.Replacement.ClearFormatting
With appWD.Selection.Find
.Text = "massfill"
.Replacement.Text = massfill
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
appWD.Selection.Find.Execute Replace:=wdReplaceAll

appWD.Selection.Find.ClearFormatting
appWD.Selection.Find.Replacement.ClearFormatting
With appWD.Selection.Find
.Text = "fill"
.Replacement.Text = fill
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
appWD.Selection.Find.Execute Replace:=wdReplaceAll

appWD.Selection.Find.ClearFormatting
appWD.Selection.Find.Replacement.ClearFormatting
With appWD.Selection.Find
.Text = "supplierfill"
.Replacement.Text = supplierfill
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
appWD.Selection.Find.Execute Replace:=wdReplaceAll

appWD.Selection.Find.ClearFormatting
appWD.Selection.Find.Replacement.ClearFormatting
With appWD.Selection.Find
.Text = "packagel"
.Replacement.Text = packagel
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
appWD.Selection.Find.Execute Replace:=wdReplaceAll

appWD.Selection.Find.ClearFormatting
appWD.Selection.Find.Replacement.ClearFormatting
With appWD.Selection.Find
.Text = "packagew"
.Replacement.Text = packagew
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
appWD.Selection.Find.Execute Replace:=wdReplaceAll

appWD.Selection.Find.ClearFormatting
appWD.Selection.Find.Replacement.ClearFormatting
With appWD.Selection.Find
.Text = "packageh"
.Replacement.Text = packageh
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
appWD.Selection.Find.Execute Replace:=wdReplaceAll

savename = "D:2002 Summer Intern ProjectWebPage_Version2Part Numbers" & partnum
foldername = "D:2002 Summer Intern ProjectWebPage_Version2Part Numbers" & partnum
savename = savename & ""
savename = savename & partnum
savename = savename & ".htm"

MkDir foldername

appWD.ActiveDocument.SaveAs filename:= _
savename _
FileFormat:=wdFormatTextLineBreaksLockComments:=FalsePassword:=""AddToRecentFiles:= _
TrueWritePassword:=""EmbedTrueTypeFonts:= _
FalseSaveNativePictureFormat:=FalseSaveFormsData:=False_
SaveAsAOCELetter:=False
appWD.Application.Quit

Application.ActivateMicrosoftApp xlMicrosoftExcel
Sheets("Master Data").Range("AL" & counter).Value = True

counter = counter + 1
foldercount = 1
folderexist = True

End If

End If

Loop Until publishend = True

End Sub

I was also trying to get the following code to work to check and see if a directory existed. There were tons of posts on this topicbut I couldn't get it to work in Excel 97. The macro would freeze any time the code attempted to retrieve err.Number. I checked the vba code help in excel and it said the range on this number was 0-65but the corresponding code for a directory that doesn't exist is 76. I'm sure that had something to do with it. I'm new to VBA and it could just be a syntax error. Here is that code.
Sub FolderCheck(foldername As Stringfoldercount As Integerfolderexist As Boolean)

On Error GoTo ErrorCheck
Do While folderexist = True
ChDir foldername
If folderexist = False Then GoTo MakeDir
If foldercount < 10 Then
foldername = foldername & "_0" & foldercount
Else
foldername = foldername & "_" & foldercount
End If
foldercount = foldercount + 1
Loop
MakeDir:
MkDir foldername
GoTo endsub
End

ErrorCheck:
Select Case Err.Number
Case 76
folderexist = False
Err.Clear
Case Else
GoTo endsub
End Select
Resume

endsub:
End Sub


Thanks for your time and the fast repies!! This site is a huge help to me as a beginner and will continue to be!!