none
How to save changes to existing excel file instead of creating a txt file with the changes? RRS feed

  • Question

  • My code reads column B from the excel file and removes values that have any underscore at the end of the character and then save it to a new txt file with the changes. But now I would like it to save whatever changes that the codes does(remove underscore) in the existing excel file and overwrite it instead of creating a new txt file with the changes... help anyone?

    Dim v_Parent, v_Child, v_Alias
    
    Dim v_Output2 
    
    Dim c_Delimiter, c_Max_Length, c_Underscore, c_Comma
    
    Dim objShell, objShell2, objFile
    
    
    Dim objExcel, objWorkbook
    
    
    Dim c_Char
    
    dim row
    
    c_Underscore = "_"
    c_Char = 1
    c_B2 = "B2" 
    c_FirstWksht      = 1
    
    Set objShell = CreateObject("Wscript.Shell")
    Set objExcel = CreateObject("Excel.Application")
    
    Set objFSO2 = CreateObject("Scripting.FileSystemObject")
        Set objWorkbook2 = objExcel.Workbooks.Open("D:\Shared\tempname\test\test2.xlsx")
              Set objFile = objFSO2.CreateTextFile("D:\Shared\tempname\test\test2.txt")
    
              Set objWorksheet2 = objWorkbook2.Worksheets(c_FirstWksht)
    
                set Description_column_n = objWorksheet2.Range(c_B2).EntireColumn
    
                For row = 1 To (Description_column_n.Rows.Count - 1)
                v_Output2 = Description_column_n.Cells(row,1).Value
    
                 Do while (Right(v_Output2, c_Char) = c_Underscore)
                   v_Output2 = left(v_Output2, len(v_Output2) - c_Char)
    
                   Loop
                objFile.Write v_Output2 & vbCRLF 
                next
    
    
    
                Set objWorkbook2 = nothing
                 objExcel.Quit
    
    
                        '********** Exit the Script **********
    
                        Wscript.Quit


    • Edited by Uongling4 Tuesday, August 5, 2014 5:39 AM
    • Moved by KareninstructorMVP Wednesday, August 6, 2014 12:39 PM Moved from VB.NET forum
    Tuesday, August 5, 2014 5:32 AM

Answers

  • Re:  Excel code

    VBA version...
    '---
    Sub VeryLittleTesting()
     Dim objExcel
     Dim objWorkbook2
     Dim objWorksheet2
     Dim Description_column_n

     Dim c_B2
     Dim c_Char
     Dim rRow
     Dim lRow
     Dim c_FirstWksht
     Dim c_Underscore
     Dim v_Output2()
     
     c_B2 = "B2"
     c_Char = 1
     c_FirstWksht = 1
     c_Underscore = "_"
     
     Set objExcel = CreateObject("Excel.Application")
     Set objWorkbook2 = objExcel.Workbooks.Open("D:\Shared\tempname\test\test2.xlsx")
     Set objWorksheet2 = objWorkbook2.Worksheets(c_FirstWksht)
     Set Description_column_n = objWorksheet2.Range(c_B2).EntireColumn
     
     lRow = Description_column_n.Cells(Description_column_n.Rows.Count, 1).End(xlUp).Row
     ReDim v_Output2(1 To lRow, 1 To 1)
     
     For rRow = 1 To lRow
      v_Output2(rRow, 1) = Description_column_n.Cells(rRow, 1).Value

      Do While (Right$(v_Output2(rRow, 1), c_Char) = c_Underscore)
        v_Output2(rRow, 1) = Left(v_Output2(rRow, 1), Len(v_Output2(rRow, 1)) - c_Char)
      Loop
     Next
     objWorksheet2.Range(Description_column_n.Cells(1, 1), Description_column_n.Cells(lRow, 1)).Value = v_Output2
     Stop  'Remove after vetting code      <<<<<<
     objWorkbook2.Close SaveChanges:=True
     
     Set Description_column_n = Nothing
     Set objWorksheet2 = Nothing
     Set objWorkbook2 = Nothing
     objExcel.Quit
     Set objExcel = Nothing
    End Sub
    '---
    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2 (Dropbox)
    (free & commercial excel add-ins & workbooks)

    Wednesday, August 6, 2014 1:46 PM

All replies

  • Hello,

    Is this VB.NET or coding in Excel (VBA)? If not VB.NET then I can move this question to an appropriate forum for Excel automation via VBA.


    Please remember to mark the replies as answers if they help and unmark them if they provide no help, this will help others who are looking for solutions to the same or similar problem.

    Tuesday, August 5, 2014 1:23 PM
  • Since you appear to be running this code from Excel I would post your question to the Excel for Developers forum:

    http://social.msdn.microsoft.com/Forums/office/en-US/home?forum=exceldev


    Paul ~~~~ Microsoft MVP (Visual Basic)

    Wednesday, August 6, 2014 12:24 PM
  • Re:  Excel code

    VBA version...
    '---
    Sub VeryLittleTesting()
     Dim objExcel
     Dim objWorkbook2
     Dim objWorksheet2
     Dim Description_column_n

     Dim c_B2
     Dim c_Char
     Dim rRow
     Dim lRow
     Dim c_FirstWksht
     Dim c_Underscore
     Dim v_Output2()
     
     c_B2 = "B2"
     c_Char = 1
     c_FirstWksht = 1
     c_Underscore = "_"
     
     Set objExcel = CreateObject("Excel.Application")
     Set objWorkbook2 = objExcel.Workbooks.Open("D:\Shared\tempname\test\test2.xlsx")
     Set objWorksheet2 = objWorkbook2.Worksheets(c_FirstWksht)
     Set Description_column_n = objWorksheet2.Range(c_B2).EntireColumn
     
     lRow = Description_column_n.Cells(Description_column_n.Rows.Count, 1).End(xlUp).Row
     ReDim v_Output2(1 To lRow, 1 To 1)
     
     For rRow = 1 To lRow
      v_Output2(rRow, 1) = Description_column_n.Cells(rRow, 1).Value

      Do While (Right$(v_Output2(rRow, 1), c_Char) = c_Underscore)
        v_Output2(rRow, 1) = Left(v_Output2(rRow, 1), Len(v_Output2(rRow, 1)) - c_Char)
      Loop
     Next
     objWorksheet2.Range(Description_column_n.Cells(1, 1), Description_column_n.Cells(lRow, 1)).Value = v_Output2
     Stop  'Remove after vetting code      <<<<<<
     objWorkbook2.Close SaveChanges:=True
     
     Set Description_column_n = Nothing
     Set objWorksheet2 = Nothing
     Set objWorkbook2 = Nothing
     objExcel.Quit
     Set objExcel = Nothing
    End Sub
    '---
    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2 (Dropbox)
    (free & commercial excel add-ins & workbooks)

    Wednesday, August 6, 2014 1:46 PM