PDA

View Full Version : Excel VBA Export Import Module



columbo1977
10-23-2008, 02:33 AM
Hello

I hope someone can help me, the piece of code below is activated by clicking a button ins a spreadsheet. It copies 2 worksheets from the workbook into a new worksheet then emails it using groupwise.

I need a module to go with it as there is code in it that is needed in the copied version to forward it on again with another button.

Please can anyone suggest how I can achieve this. :

Code for the main emailing :



Sub STL1_ActiveWorkbook()

Dim wb As Workbook
Dim NewBook As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet


Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wb = ActiveWorkbook

'Copy worksheet
Dim NewShtName1 As String
Dim NewShtName2 As String

NewShtName1 = "BAO4PCAH"
NewShtName2 = "HC24"

Sheets(Array("BA04PCAH", "HC24")).Copy
Set wb = ActiveWorkbook
wb.Sheets("BA04PCAH").Name = NewShtName1
wb.Sheets("HC24").Name = NewShtName2

Dim sTemp As String
sTemp = Environ("TEMP")

If Dir$(sTemp & "\BAO4PCAH.xls") <> "" Then
Kill sTemp & "\BAO4PCAH.xls"
End If

'Save the new spreadsheet with password protection

wb.SaveAs Filename:=sTemp & "\" & NewShtName1, FileFormat:= _
xlNormal, Password:="XXX", ReadOnlyRecommended:= _
True, CreateBackup:=False

Call ExportAndImportOneModule

ActiveWorkbook.Close False

Dim Path As String
Dim File As String

Path = sTemp
File = "BAO4PCAH"
Call Email_Via_Groupwise("YourMailBoxIDGoesHere", _
email@email.com, _
"Please find attached the ", _
"Please find attached the ", _
sTemp & "\" & NewShtName1 & ".xls")

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub


the code that I am trying to get working for the module copy :



Sub ExportAndImportOneModule()
Dim sTemp As String
sTemp = Environ("TEMP")

If Dir$(sTemp & "\code.bas") <> "" Then
Kill sTemp & "\code.bas"
End If
'export from Book2
Workbooks("BA03 Nov2008v1.3").VBProject.VBComponents("Module7").Export _
Workbooks("BA03 Nov2008v1.3").sTemp & "\code.bas"
'import to Book1
Workbooks("BA04PCAH").VBProject.VBComponents.Import _
Workbooks("BA04PCAH").sTemp & "\code.bas"
End Sub


the code that emails the workbook using groupwise :




Option Explicit
Private ogwApp As GroupwareTypeLibrary.Application
Private ogwRootAcct As GroupwareTypeLibrary.account
Public Sub Email_Via_Groupwise(sLoginName As String, _
sEmailTo As String, _
sSubject As String, _
sBody As String, _
Optional sAttachments As String, _
Optional sEmailCC As String, _
Optional sEmailBCC As String)
'Author : Ken Puls (www.excelguru.ca (http://www.excelguru.ca))
'Macro purpose: To stand as a self contained procedure for creating and
' sending an email via groupwise
'NOTE: You can feed a comma separated string of address to all
' address and attachment fields
On Error GoTo EarlyExit
'Required variable declarations
Const NGW$ = "NGW"
Dim ogwNewMessage As GroupwareTypeLibrary.Mail
Dim aryTo() As String, _
aryCC() As String, _
aryBCC() As String, _
aryAttach() As String
Dim lAryElement As Long
'Split the emails into an array if necessary
aryTo = Split(sEmailTo, ",")
aryCC = Split(sEmailCC, ",")
aryBCC = Split(sEmailBCC, ",")
aryAttach = Split(sAttachments, ",")
'Set application object reference if needed
Application.StatusBar = "Logging in to email account..."
If ogwApp Is Nothing Then
DoEvents
Set ogwApp = CreateObject("NovellGroupWareSession")
DoEvents
End If
'Login to root account if required
If ogwRootAcct Is Nothing Then
Set ogwRootAcct = ogwApp.Login(sLoginName, vbNullString, _
, egwPromptIfNeeded)
DoEvents
End If
'Create new message
Application.StatusBar = "Building email to " & sEmailTo & "..."
Set ogwNewMessage = ogwRootAcct.WorkFolder.Messages.Add _
("GW.MESSAGE.MAIL", egwDraft)
DoEvents
'Assign message properties
With ogwNewMessage
'To field
For lAryElement = 0 To UBound(aryTo())
.Recipients.Add aryTo(lAryElement), NGW, egwTo
Next lAryElement
'CC Field
For lAryElement = 0 To UBound(aryCC())
.Recipients.Add aryCC(lAryElement), NGW, egwCC
Next lAryElement
'BCC Field
For lAryElement = 0 To UBound(aryBCC())
.Recipients.Add aryBCC(lAryElement), NGW, egwBC
Next lAryElement
'Subject & body
.Subject = sSubject
.BodyText = sBody
'Attachments (if any)
For lAryElement = 0 To UBound(aryAttach())
If Not aryAttach(lAryElement) = vbNullString Then _
.Attachments.Add aryAttach(lAryElement)
Next lAryElement
'Send the message (Sending may fail if recipients don't resolve)
On Error Resume Next
.Send
DoEvents
If Err.Number = 0 Then Application.StatusBar = "Message sent!" _
Else: Application.StatusBar = "Email to " & sEmailTo & " failed!"
On Error GoTo 0
End With
EarlyExit:
'Release all variables
Set ogwNewMessage = Nothing
Set ogwRootAcct = Nothing
Set ogwApp = Nothing
DoEvents
Application.StatusBar = False
End Sub



the error that appears when i run this varies from :

Run Time Error 438 - Object doesnt support this property or method

or I was getting - programmatic access to visual basic application

Please can someone help me sort this

Thanks for looking

Graham