Automatically open, close & saved documents

Hi all,

I need your assistance to help me to open, close & saved a database file.
Below is the VB Script ,
Thank you in advance

Sub UpdateLogWorksheet()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim nextRow As Long
    Dim oCol As Long

    Dim myRng As Range
    Dim myCopy As String
    Dim myCell As Range
    
    'cells to copy from database sheet - some contain formulas
    myCopy = "P1,E1,E2,E3,E4,E5,AI2,W3,W4,W5,W6,E6,P2,P3,P4,P5,AF5,AF6,AJ6"

    Set inputWks = Worksheets("source")
    Set historyWks = Workbooks("database.xlsx").Worksheets("data")

    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With inputWks
        Set myRng = .Range(myCopy)

        If Application.CountA(myRng) <> myRng.Cells.Count Then
            MsgBox "Please fill in all the YELLOW coloured cells!"
            Exit Sub
        End If
    End With

    With historyWks
        With .Cells(nextRow, "A")
            .Value = Now
            .NumberFormat = "dd/mm/yyyy hh:mm:ss"
        End With
        .Cells(nextRow, "B").Value = Application.UserName
        oCol = 3
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With
    
End Sub

Hi,

The following will probably do what you want, but has no error checking.

Sub SimpleOpenSaveCloseFileWithNoErrorChecking()
    
    Dim sFileName As String
    Dim sPath As String
    Dim sPathAndFileName As String
    
    'Build a File Name (i.e. Worksheet name) and 'Path and File Name'
    'Assume the 'Workbook' is in the same folder as the file running the code
    sPath = ThisWorkbook.Path & "\"
    sFileName = "database.xlsx"
    sPathAndFileName = sPath & sFileName
    
    'Disable macros in the file being opened (optional)
    Application.EnableEvents = False

    Workbooks.Open Filename:=sPathAndFileName
    
    'Reenable Macros
    Application.EnableEvents = True
    
    
    'Save file and keep open
    Workbooks(sFileName).Save

    'or Save the File and Close
    Workbooks(sFileName).Close SaveChanges:=True
    
    'or Close the file and don't save
    Application.DisplayAlerts = False     'Inhibit 'Do you really want to do this ...' question
    Workbooks(sFileName).Close SaveChanges:=False
    Application.DisplayAlerts = True
    
End Sub

For an example of some of the same code with extensive error checking see post #3 or post #5 from http://www.excelforum.com/excel-gene...ta-weekly.html

Lewis

Dear Lewis,

Thank you for your reply, but
can this script combined with my "updatelogworksheet"? because I want the
file open & after update it'll closed & saved by itself... thanks again

namialus,

Try this. It opens the file, runs your macro code, then saves and closes the file.

Lewis

Sub UpdateLogWorksheet()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim nextRow As Long
    Dim oCol As Long

    Dim myRng As Range
    Dim myCopy As String
    Dim myCell As Range
    
    Dim sHistoryFileName As String
    Dim sPath As String
    Dim sPathAndFileName As String
    
    'Build a File Name (i.e. Worksheet name) and 'Path and File Name'
    'Assume the 'Workbook' is in the same folder as the file running the code
    'Change the path if your path is DIFFERENT
    sPath = ThisWorkbook.Path & "\"
    sHistoryFileName = "database.xlsx"
    sPathAndFileName = sPath & sHistoryFileName
    
    'Open the data file
    Workbooks.Open Filename:=sPathAndFileName
    
    myCopy = "P1,E1,E2,E3,E4,E5,AI2,W3,W4,W5,W6,E6,P2,P3,P4,P5,AF5,AF6,AJ6"

    Set inputWks = Worksheets("source")
    Set historyWks = Workbooks("database.xlsx").Worksheets("data")
    
    'You should probably change the previous line to:
    Set historyWks = Workbooks(sHistoryFileName).Worksheets("data")
    
    

    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With inputWks
        Set myRng = .Range(myCopy)

        If Application.CountA(myRng) <> myRng.Cells.Count Then
            MsgBox "Please fill in all the YELLOW coloured cells!"
            Exit Sub
        End If
    End With

    With historyWks
        With .Cells(nextRow, "A")
            .Value = Now
            .NumberFormat = "dd/mm/yyyy hh:mm:ss"
        End With
        .Cells(nextRow, "B").Value = Application.UserName
        oCol = 3
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With
    
    'Save the File and Close
    Workbooks(sHistoryFileName).Close SaveChanges:=True
    
End Sub

Dear Lewis,

I received error "run-time error 9 ; subscript out of range"
& yellow mark at script line :

Set inputWks = Worksheets("source")

Note : The database file opened but no input ...

Thank you again

I didn't test the macro the first time because I didn't think anything could go wrong, go wrong, go wrong. I was misinformed. I apologize.

I had to move the item in blue to the beginning of the macro. The macro was looking for Sheet 'source' in the wrong workbook.

Try again with:

Sub UpdateLogWorksheet()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim nextRow As Long
    Dim oCol As Long

    Dim myRng As Range
    Dim myCopy As String
    Dim myCell As Range
    
    Dim sHistoryFileName As String
    Dim sPath As String
    Dim sPathAndFileName As String
    
    'Set the Input Worksheet object (from the Active Workbook)
    Set inputWks = Worksheets("source")
    
    'Build a File Name (i.e. Worksheet name) and 'Path and File Name'
    'Assume the 'Workbook' is in the same folder as the file running the code
    'Change the path if your path is DIFFERENT
    sPath = ThisWorkbook.Path & "\"
    sHistoryFileName = "database.xlsx"
    sPathAndFileName = sPath & sHistoryFileName
    
    'Open the data file
    Workbooks.Open Filename:=sPathAndFileName
    
    myCopy = "P1,E1,E2,E3,E4,E5,AI2,W3,W4,W5,W6,E6,P2,P3,P4,P5,AF5,AF6,AJ6"

    Set historyWks = Workbooks("database.xlsx").Worksheets("data")
    
    'You should probably change the previous line to:
    Set historyWks = Workbooks(sHistoryFileName).Worksheets("data")
    
    

    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With inputWks
        Set myRng = .Range(myCopy)

        If Application.CountA(myRng) <> myRng.Cells.Count Then
            MsgBox "Please fill in all the YELLOW coloured cells!"
            Exit Sub
        End If
    End With

    With historyWks
        With .Cells(nextRow, "A")
            .Value = Now
            .NumberFormat = "dd/mm/yyyy hh:mm:ss"
        End With
        .Cells(nextRow, "B").Value = Application.UserName
        oCol = 3
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With
    
    'Save the File and Close
    Workbooks(sHistoryFileName).Close SaveChanges:=True
    
End Sub

Lewis

Dear Lewis,

The macro working , thank you very much