ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   If Then Help (https://www.excelbanter.com/excel-programming/328465-if-then-help.html)

hurlbut777

If Then Help
 
I have put together VBA code that copies data from one workbook(active) and
pastes into another workbook(destination). I am wanting to insert a
statement that if the destination workbook cannot be find, run another string
of code that would email the file, otherwise continue running the current
code. Below is the code to copy and paste as well as the email code. Can
someone please help me in using an if/then statement to meet my objective
above.

Sub McoSave()
Application.ScreenUpdating = False

Dim WBto As Workbook
Dim FromSheet As Worksheet
Dim ToSheet As Worksheet
Dim C1 As String
Dim LastRow As Long

Set FromSheet = ThisWorkbook.Worksheets("results")
C1 = "A2:T2"
FromSheet.Range(C1).Copy

Set WBto = Workbooks.Open(Filename:="F:\Jeff_H\Survey Test\Survey2.xls")
Set ToSheet = WBto.Worksheets("Survey2")

LastRow = ToSheet.Range("A6536").End(xlUp).Row + 1



ToSheet.Range("A" & LastRow).PasteSpecial xlPasteValues
WBto.Close SaveChanges:=True
Set WBto = Nothing

Application.ScreenUpdating = True
Beep
strMB = MsgBox("Survey has been saved. " & _
"Thank you for participating.", vbOKOnly, "Finance Group Survey")

Application.ActiveWorkbook.Close SaveChanges:=False

End Sub

Sub Email()

Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = ".com"
.CC = ""
.BCC = ""
.Subject = "Survey"
.Body = "Test"
.Attachments.Add ActiveWorkbook.FullName
.Send
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Tom Ogilvy

If Then Help
 
Sub McoSave()
Application.ScreenUpdating = False

Dim WBto As Workbook
Dim FromSheet As Worksheet
Dim ToSheet As Worksheet
Dim C1 As String
Dim LastRow As Long
if dir("F:\Jeff_H\Survey Test\Survey2.xls") < "" then
Set FromSheet = ThisWorkbook.Worksheets("results")
C1 = "A2:T2"
FromSheet.Range(C1).Copy
Set WBto = Workbooks.Open(Filename:="F:\Jeff_H\Survey Test\Survey2.xls")
Set ToSheet = WBto.Worksheets("Survey2")

LastRow = ToSheet.Range("A6536").End(xlUp).Row + 1



ToSheet.Range("A" & LastRow).PasteSpecial xlPasteValues
WBto.Close SaveChanges:=True
Set WBto = Nothing

Application.ScreenUpdating = True
Beep
strMB = MsgBox("Survey has been saved. " & _
"Thank you for participating.", vbOKOnly, "Finance Group Survey")

Application.ActiveWorkbook.Close SaveChanges:=False
else
Email
End if

End Sub

Sub Email()

Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = ".com"
.CC = ""
.BCC = ""
.Subject = "Survey"
.Body = "Test"
.Attachments.Add ActiveWorkbook.FullName
.Send
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

--
Regards,
Tom Ogilvy

"hurlbut777" wrote in message
...
I have put together VBA code that copies data from one workbook(active)

and
pastes into another workbook(destination). I am wanting to insert a
statement that if the destination workbook cannot be find, run another

string
of code that would email the file, otherwise continue running the current
code. Below is the code to copy and paste as well as the email code. Can
someone please help me in using an if/then statement to meet my objective
above.

Sub McoSave()
Application.ScreenUpdating = False

Dim WBto As Workbook
Dim FromSheet As Worksheet
Dim ToSheet As Worksheet
Dim C1 As String
Dim LastRow As Long

Set FromSheet = ThisWorkbook.Worksheets("results")
C1 = "A2:T2"
FromSheet.Range(C1).Copy

Set WBto = Workbooks.Open(Filename:="F:\Jeff_H\Survey

Test\Survey2.xls")
Set ToSheet = WBto.Worksheets("Survey2")

LastRow = ToSheet.Range("A6536").End(xlUp).Row + 1



ToSheet.Range("A" & LastRow).PasteSpecial xlPasteValues
WBto.Close SaveChanges:=True
Set WBto = Nothing

Application.ScreenUpdating = True
Beep
strMB = MsgBox("Survey has been saved. " & _
"Thank you for participating.", vbOKOnly, "Finance Group Survey")

Application.ActiveWorkbook.Close SaveChanges:=False

End Sub

Sub Email()

Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = ".com"
.CC = ""
.BCC = ""
.Subject = "Survey"
.Body = "Test"
.Attachments.Add ActiveWorkbook.FullName
.Send
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub




Nigel

If Then Help
 
You could try using the Dir command, which will return an empty string if
the path&file is not found.

if Len(Dir("F:\Jeff_H\Survey Test\Survey2.xls")) 0 then
' do something as the file exists
else
' do as the file does not exist
endif


--
Cheers
Nigel



"hurlbut777" wrote in message
...
I have put together VBA code that copies data from one workbook(active)

and
pastes into another workbook(destination). I am wanting to insert a
statement that if the destination workbook cannot be find, run another

string
of code that would email the file, otherwise continue running the current
code. Below is the code to copy and paste as well as the email code. Can
someone please help me in using an if/then statement to meet my objective
above.

Sub McoSave()
Application.ScreenUpdating = False

Dim WBto As Workbook
Dim FromSheet As Worksheet
Dim ToSheet As Worksheet
Dim C1 As String
Dim LastRow As Long

Set FromSheet = ThisWorkbook.Worksheets("results")
C1 = "A2:T2"
FromSheet.Range(C1).Copy

Set WBto = Workbooks.Open(Filename:="F:\Jeff_H\Survey

Test\Survey2.xls")
Set ToSheet = WBto.Worksheets("Survey2")

LastRow = ToSheet.Range("A6536").End(xlUp).Row + 1



ToSheet.Range("A" & LastRow).PasteSpecial xlPasteValues
WBto.Close SaveChanges:=True
Set WBto = Nothing

Application.ScreenUpdating = True
Beep
strMB = MsgBox("Survey has been saved. " & _
"Thank you for participating.", vbOKOnly, "Finance Group Survey")

Application.ActiveWorkbook.Close SaveChanges:=False

End Sub

Sub Email()

Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = ".com"
.CC = ""
.BCC = ""
.Subject = "Survey"
.Body = "Test"
.Attachments.Add ActiveWorkbook.FullName
.Send
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub





All times are GMT +1. The time now is 01:03 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com