본문 바로가기
취미/Soft

[엑셀,VB] 엑셀 초단위 세이브하는 프로그램 수정판

by MDabsurd 2015. 8. 25.

Range 만 잡아서, Text File 로 저장하는 기능 추가. 

0. .net45 가 컴에 런타임이 깔려 있어야 돌겁니다.
   보통 깔려 있으실 듯.
1. 엑셀은 미리 띄워 두셔야 합니다.
2. Excel 화일명으로 지정된 인스턴스를 찾아 링크합니다.
3. Sheet Name 은 딱 정해져 있는 "MyData" 를 참조합니다.
4. 에러 처리 루틴이 없어서, 동작 중 삑사리가 나면,
   작업 관리자에서 엑셀 프로세스를 죽여 주셔야 돌 겁니다.

xlssaver12.rar

 

Imports System.IO
Public Class frmXLSMain
    Dim excelObj As Object
    Dim excelbook As Object
    Dim excelsheet As Object


    Private Sub btnConnect_Click(sender As Object, e As EventArgs) Handles btnConnect.Click

        Dim ExcelFileName As String = tbxExcelFile.Text

        If Not My.Computer.FileSystem.FileExists(ExcelFileName) Then
            MsgBox(ExcelFileName & " does not exist")
            Exit Sub
        End If

        '특정 Excel File 을 물고 있는 엑셀 인스턴스를 링크

        excelObj = GetObject(ExcelFileName).Application

        excelObj.Application.Visible = True

        Dim winCount As Integer = excelObj.Parent.Windows.Count()
        excelObj.Parent.Windows(winCount).Visible = True

        If winCount > 0 Then
            ToolStripStatusLabel1.Text = "Connected to " + ExcelFileName
        End If

        excelbook = excelObj.Workbooks(1)
        excelsheet = excelbook.WorkSheets("Mydata") 'Region save 기능 구현시 Sheet Name 을 참조하게 한다
    End Sub

    Private Sub btnStart_Click(sender As Object, e As EventArgs) Handles btnStart.Click
        tmrInterval.Interval = Convert.ToInt32(tbxInterval.Text) * 1000
        tmrInterval.Start()
        ToolStripStatusLabel1.Text = "Saving Data..."

    End Sub

    Private Sub btnInputSet_Click(sender As Object, e As EventArgs) Handles btnInputSet.Click
        OpenFileDialog1.ShowDialog()
        If OpenFileDialog1.FileName <> "" Then
            tbxExcelFile.Text = OpenFileDialog1.FileName
        End If
        ToolStripStatusLabel1.Text = "Base Excel File Set..."
    End Sub

    Private Sub frmXLSMain_FormClosed(sender As Object, e As FormClosedEventArgs) Handles MyBase.FormClosed
        excelObj = Nothing
        excelbook = Nothing
        excelsheet = Nothing
    End Sub

    Private Sub btnStop_Click(sender As Object, e As EventArgs) Handles btnStop.Click
        tmrInterval.Stop()
        ToolStripStatusLabel1.Text = "Ready"
    End Sub

    Private Sub tmrInterval_Tick(sender As Object, e As EventArgs) Handles tmrInterval.Tick

        Dim writer As StreamWriter = New StreamWriter(tbxOutFolder.Text + tbxOutPrefix.Text + Format(Now, "hh_mm_ss") + ".txt")

        
        

        If rbtnWholeSave.Checked = True Then
            excelbook.SaveAs(tbxExcelFile.Text + Format(Now, "hh_mm_ss") + ".xlsx")
        Else

            For i = Convert.ToInt32(tbxRm.Text) To (Convert.ToInt32(tbxRn.Text))
                For j = Convert.ToInt32(tbxCm.Text) To (Convert.ToInt32(tbxCn.Text))
                    'MsgBox(Convert.ToString(excelsheet.cells(j, i).value))
                    writer.WriteLine(Convert.ToString(excelsheet.cells(j, i).value))
                Next
            Next

            writer.Close()
        End If
    End Sub

    Private Sub btnOutSet_Click(sender As Object, e As EventArgs) Handles btnOutSet.Click
        FolderBrowserDialog1.ShowDialog()
        If FolderBrowserDialog1.SelectedPath <> "" Then
            tbxOutFolder.Text = FolderBrowserDialog1.SelectedPath + "\"
        End If
    End Sub
End Class

감사합니다 하하하~

댓글