Consulting

Results 1 to 9 of 9

Thread: Solved: help with excel vba...

  1. #1

    Solved: help with excel vba...

    hi,

    i have a vb form (within word). this form has four text fields and a button. user enters some info in these text fields and on button click, these values are added into four columns (C, D, E and H) at the very end of the spreadsheet - after the last populated line. the next time i run this, it should add the info into the four columns in the next line -after the previous additions.

    this is the code i have:
    Private Sub cmdAppend_Click()
        
    
        Dim xlsWB1 As Object
        Dim xlsWS1 As Object
        Dim strFileName As String
        Dim oRange As Range
        
        'strFileName = "D:\xxxxxxx\POC\US Reporters_123.xls"
        'Opening the file to parse now
        Set xlsApp = CreateObject("Excel.Application")
        xlsApp.Visible = True 'Makes Excel File visible.
        Set xlsWB1 = xlsApp.Workbooks.Open(strFileName)
        
        Set xlSheet = xlsWB1.Worksheets(1)
        
        xlSheet.Activate
        xlSheet.Range("A1").Select
        
        Dim col As Integer
        Dim row As Integer
        Dim maxrow As Integer
        Dim maxcol As Integer
        Dim str As String
        Dim rListPaste As Range
        
        
        str = ""
        maxrow = xlSheet.Range("A1").CurrentRegion.Rows.Count
        
        maxcol = 9
        
        'Reading the Excel file and putting everything in Memory for faster manipulation
    
        row = maxrow + 1
        
        xlSheet.Range("C" & row).Value = txtReporterName.Text
        xlSheet.Range("D" & row).Value = txtPrimaryAbbrev.Text
        xlSheet.Range("E" & row).Value = txtSampleCite.Text
        xlSheet.Range("H" & row).Value = txtReporterType.Text
        
        xlsWB1.SaveAs ("D:\xxxxx\POC\US Reporters_1234.xls")
                
        xlsApp.Quit
        Set xlsApp = Nothing
        AppendDictionary
    End
    what this code does is, it detects the US Reporters_1234.xls and asks me if I want to overwrite it. If i say 'yes', i lose the values i entered the first time around and only the second iteration is retained. how can i keep appending this file?

    i would want to know if it is possible to just back up the original (US Reporters.xls) and then create a copy of that (say, US Reporters_1234.xls) the first time around. Then, the code should look for this file, US Reporters_1234.xls and if it finds it, append it with the new values. else, just back up the original and create a new copy and work with it.

    if this is possible, how do i do it? help is greatly appreciated.
    thankkksss in advance...

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,903
    Location
    [vba]maxrow = xlSheet.Range("A" & Rows.Count).End(xlup).Row[/vba]

  3. #3
    [quote=Kenneth Hobs][vba]maxrow = xlSheet.Range("A" & Rows.Count).End(xlup).Row[/vba][/quote
    This does not do what i want it to do. It still asks me if I would want to overwrite US Reporters_1234.xls. If I say yes, it opens up a fresh US Reporters_1234.xls and then inserts this new line. I have lost what i had inserted in my first iteration.

    I need to be able to check the folder to see if US Reporters_1234.xls exists. If it does, then open it and append it. if it does not exist, then open US Reporters_123.xls, append it and save it as US Reporters_1234.xls. This way, I still retain the original (US Reporters_123.xls) just in case I want to revert back to it.
    Last edited by lazyuser; 02-19-2009 at 11:14 AM.

  4. #4
    anyone?

    How do i check to see if this particular file (US Reporters_1234) exists? What I need to do is, if this file already exists, then open it and work on it again (append it). else, open US Reporters123.xls, and then work on it and save it as US Reporters_1234.xls!

    HELP PLEEEASE

  5. #5
    VBAX Contributor
    Joined
    May 2008
    Posts
    198
    Location
    [VBA]Function checkFileExists(ByVal filePath As String) As Boolean
    On Error GoTo errorcode
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    checkFileExists = fso.fileExists(filePath )

    Set fso = Nothing
    Exit Function
    errorcode:
    checkFileExists = false
    End Function
    [/VBA]

  6. #6
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Simplified locations for my tests.

    BTW Str changed to Txt. Str is a VBA function.
    [vba]
    Private Sub CommandButton1_Click()

    Dim xlsWB1 As Object
    Dim xlsWS1 As Object
    Dim strFileName As String
    Dim oRange As Range
    Dim xlsApp, xlsheet

    'Check for file
    Dim Test As String
    Test = Dir("C:\AAA\us1234.xls")
    If Len(Test) = 0 Then
    strFileName = "C:\AAA\us123.xls"
    Else
    strFileName = "C:\AAA\us1234.xls"
    End If

    'Opening the file to parse now
    Set xlsApp = CreateObject("Excel.Application")
    xlsApp.Visible = True 'Makes Excel File visible.
    Set xlsWB1 = xlsApp.Workbooks.Open(strFileName)

    Set xlsheet = xlsWB1.Worksheets(1)

    xlsheet.Activate
    xlsheet.Range("A1").Select

    Dim col As Integer
    Dim row As Integer
    Dim maxrow As Integer
    Dim maxcol As Integer
    Dim txt As String
    Dim rListPaste As Range


    txt = ""
    ' CHECK THE RESULT HERE @@@@@@@@@@@@@@@@@@@@@@@
    maxrow = xlsheet.Range("C2").CurrentRegion.Rows.Count + 1

    maxcol = 9

    'Reading the Excel file and putting everything in Memory for faster manipulation
    row = maxrow + 1

    xlsheet.Range("C" & row).Value = TextBox1.Text
    xlsheet.Range("D" & row).Value = TextBox2.Text
    xlsheet.Range("E" & row).Value = TextBox3.Text
    xlsheet.Range("H" & row).Value = TextBox4.Text

    xlsApp.DisplayAlerts = False
    xlsWB1.SaveAs ("C:\AAA\us1234.xls")
    xlsApp.DisplayAlerts = True
    xlsApp.Quit
    Set xlsApp = Nothing
    'AppendDictionary
    End
    End Sub

    [/vba]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  7. #7
    Quote Originally Posted by mdmackillop
    Simplified locations for my tests.

    BTW Str changed to Txt. Str is a VBA function.
    this code still does not work. if us1234.xls does not exist, it says check the file name. if it does, it opens it, writes into it(appends it) but does not save it!

  8. #8
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    How about checking whether a Save or SaveAs is required
    [VBA]'Check for file
    Dim Chk As Boolean
    Dim Test As String
    Test = Dir("C:\AAA\us1234.xls")
    If Len(Test) = 0 Then
    strFileName = "C:\AAA\us123.xls"
    Else
    strFileName = "C:\AAA\us1234.xls"
    Chk = True
    End If[/VBA]
    and for the save

    [VBA]If Chk = True Then
    xlsWB1.Save
    Else
    xlsWB1.SaveAs ("C:\AAA\us1234.xls")
    End If[/VBA]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  9. #9
    Quote Originally Posted by mdmackillop
    [vba]If Chk = True Then
    xlsWB1.Save
    Else
    xlsWB1.SaveAs ("C:\AAA\us1234.xls")
    End If[/vba]
    aah, didnt think about the flag! thanks much mdmackillop! it works like a champ!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •