Closing a workbook after it has opened another
Nope, that didn't work.
workbook1
Private Sub Workbook_Open()
Run "BackEndDSET"
End Sub
Sub BackEndDSET()
Workbooks.Open Filename:= _
"T:\SOC\Residential Directory\DSET Error Tracking\DSET Error
Track to Access Database.xls"
Application.Run "'DSET Error Track to Access
Database.xls'!OpenDate"
MsgBox ("Back to Automation Workbook")
Windows("DSET Back End Automation.xls").Close False
End Sub
workbook2
Sub OpenDate()
'
' OpenDate Macro
' Macro recorded 10/19/2006 by JBERGSTE
'
'
Dim ThsDate
Dim ThsMonth
Dim ThsYear
Dim SaveAsDate As String
Dim DSETDate As String
ThsDate = Date
ThsDate = ThsDate - 1
ThsMonth = Right("0" & Month(ThsDate), 2)
MnthNme = MonthName(ThsMonth, True)
ThsYear = Year(ThsDate)
ThsDay = Right("0" & Day(ThsDate), 2)
SaveAsDate = ThsYear & ThsMonth & ThsDay
DSETDate = ThsMonth & "-" & ThsDay & "-" & ThsYear
'Check to see if the directory exists for the current year, create
it if it does not
Dim AuditDirectory As String, DirTest As String
AuditDirectory = "T:\SOC\Residential Directory\DSET Error
Tracking\" & ThsYear
DirTest = Dir$(AuditDirectory, vbDirectory) 'see if exists
If DirTest = "" Then
MkDir "T:\SOC\Residential Directory\DSET Error Tracking\" &
ThsYear ' create if not there
DoEvents 'make sure it is there
End If
'Next, check to see if the directory for the current month exists,
create it if it does not
AuditDirectory = "T:\SOC\Residential Directory\DSET Error
Tracking\" & ThsYear & "\" & ThsMonth & "-" & MnthNme & " Test"
DirTest = Dir$(AuditDirectory, vbDirectory) 'see if exists
If DirTest = "" Then
MkDir "T:\SOC\Residential Directory\DSET Error Tracking\" &
ThsYear & "\" & ThsMonth & "-" & MnthNme & " Test" ' create if not
there
DoEvents 'make sure it is there
End If
'Save the workbook with a YYYYMMDD format
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"T:\SOC\Residential Directory\DSET Error Tracking\" & ThsYear &
"\" & ThsMonth & "-" & MnthNme & " Test\" & SaveAsDate & ".xls",
FileFormat:= _
xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Save
Application.DisplayAlerts = True
DSETWrkBk = ActiveWorkbook.Name
Workbooks.Open Filename:= _
"http://10.62.204.46:10001/searchresstateEx.php?FormName=SearchInType&FormAct ion=search&s_state=VA&v_enddate1="
& DSETDate & "&v_startdate1=" & DSETDate & "&"
RESPWrkBk = ActiveWorkbook.Name
Range("A4").Select
LstRw = 0
Do Until ActiveCell.Value = ""
PON = Range("B" & ActiveCell.Row).Value
PONTest = Left(PON, 1)
Select Case PONTest
Case "H", "V", "W"
LstRw = ActiveCell.Row
End Select
ActiveCell.Offset(1, 0).Select
Loop
If LstRw = 0 Then
ActiveWorkbook.Close False
Windows(DSETWrkBk).Activate
Sheets("All Responses").Select
Range("A3").Value = "No Orders For This Date"
GoTo label1
End If
Range("A4:I" & LstRw).Select
Selection.Copy
Windows(DSETWrkBk).Activate
Sheets("All Responses").Select
Range("A3").Select
ActiveSheet.Paste
Application.DisplayAlerts = False
Windows(RESPWrkBk).Activate
ActiveWorkbook.Close False
Application.DisplayAlerts = True
Windows(DSETWrkBk).Activate
Range("A3").Select
Run "MoveOrdersToProperWorksheet"
label1:
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
|