Code won't run in all worksheets

[crysclayton]

Hello there,

I've pieced together code that uses worksheet rows to generate VCS
files for importing into Outlook. It works just the way they asked,
except it only works for the worksheet referred to in the code
("Sheet4"), and not for every sheet in the workbook. A button on each
worksheet runs the macro ThisWorkbook.ToCalendar successfully, but of
course it only exports content from Sheet4, not the current/active
worksheet.

Can someone help me with referring to "thisworksheet" or whatever it
takes to get this to run on every sheet? I think this previous post
answers my question, but I am not sure how to apply it:
http://groups.google.com/group/micr...read/thread/8e4b22454728506d/45fe0c52fec8ae2a

Thanks in advance!
Crys

Here's the code:

*******************************************************************

'From http://support.microsoft.com/?kbid=209231
Sub ToCalendar()
Dim colA, colB, colC, colD, colE As String
Dim strDirName, strContents, strEventName, strFilename As String
Dim i As Long
Dim WSHShell As Object

' Setup on locating desktop for creating/saving data folder and
file
Set WSHShell = CreateObject("Wscript.Shell")
strDirName = WSHShell.SpecialFolders("Desktop") & "\Import " &
Sheets("Sheet4").Cells(2, 3).Value & " Tasks"

'***
'***check that this exists before creating it, delete with <rmDir /s /q
\directoryname> if it does***
MkDir strDirName
'***
'***

'Loop through the task items on the worksheet
With Sheets("Sheet4")
For i = 200 To 1 Step -1
If IsDate(.Cells(i, 2).Value) = True Then
' Read data into variables.
colA = .Cells(i, 1).Value
colB = Format(.Cells(i, 2).Value, "yyyymmdd")
colD = .Cells(i, 4).Value
colE = .Cells(i, 5).Value
colF = Format(.Cells(i, 6).Value, "yyyymmdd")

strEventName = Replace(colE, " ", "")
strFilename = strEventName & "_" & i - 7

' Create data file and open it for input
Open strDirName & "\" & strFilename & ".vcs" For Output
As #1
' Open WSHShell.SpecialFolders("Desktop") & "\" &
strFilename & ".vcs" For Output As #1

' Build the vcs file contents
strContents = "BEGIN:VCALENDAR" & Chr(13) & Chr(10)
strContents = strContents & "PRODID:-//Microsoft
Corporation//Outlook 11.0 MIMEDIR//EN" & Chr(13) & Chr(10)
strContents = strContents & "VERSION:1.0" & Chr(13) &
Chr(10)
strContents = strContents & "BEGIN:VEVENT" & Chr(13) &
Chr(10)
strContents = strContents & "DTSTART:" & colB &
"T040000Z" & Chr(13) & Chr(10)
strContents = strContents & "DTEND:" & colF &
"T040000Z" & Chr(13) & Chr(10)
strContents = strContents & "DESCRIPTION:" & colD &
Chr(13) & Chr(10)
strContents = strContents & "SUMMARY" & colA & ") "
& colE & Chr(13) & Chr(10)
strContents = strContents & "END:VEVENT" & Chr(13) &
Chr(10)
strContents = strContents & "END:VCALENDAR"

Print #1, strContents '*** trim first and last
characters (this method adds quotes) ***

' Close file.
Close #1
End If
Next
End With
Set WSHShell = Nothing
End Sub

 

[crysclayton]

Hi Jim,

All the code I posted there is all there is... I promise

Crystal

 

[crysclayton]

Hi Jim,

That works perfectly for iterating through all the worksheets, but I
only want to export content from the worksheet that is active/current.
Sorry that I didn't make that clear in my first post...

Thanks again
Crystal

 

[Norman Jones]

Hi Crys,

Try changing:

With Sheets("Sheet4")
to

With Activesheet

 

[crysclayton]

Hi Norman,

That was _exactly_ what I needed to change. Now everything works just
as they want it to.

I feel so "Duh!" for not figuring that out, but am grateful the
solution was that simple!

Many thanks
Crys