PDA

View Full Version : Solved: help with excel vba...



lazyuser
02-18-2009, 02:36 PM
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...

Kenneth Hobs
02-18-2009, 03:14 PM
maxrow = xlSheet.Range("A" & Rows.Count).End(xlup).Row

lazyuser
02-18-2009, 03:32 PM
[quote=Kenneth Hobs]maxrow = xlSheet.Range("A" & Rows.Count).End(xlup).Row[/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.

lazyuser
02-19-2009, 11:09 AM
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

Cosmo
02-19-2009, 11:16 AM
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

mdmackillop
02-19-2009, 12:27 PM
Simplified locations for my tests.

BTW Str changed to Txt. Str is a VBA function.

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

lazyuser
02-19-2009, 01:46 PM
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!

mdmackillop
02-19-2009, 02:43 PM
How about checking whether a Save or SaveAs is required
'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
and for the save

If Chk = True Then
xlsWB1.Save
Else
xlsWB1.SaveAs ("C:\AAA\us1234.xls")
End If

lazyuser
02-19-2009, 03:42 PM
If Chk = True Then
xlsWB1.Save
Else
xlsWB1.SaveAs ("C:\AAA\us1234.xls")
End If

aah, didnt think about the flag! thanks much mdmackillop! it works like a champ!