View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
belkingold belkingold is offline
external usenet poster
 
Posts: 8
Default 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