joeythelips
IS-IT--Management
Hi.
I have this bit of vba for excel.
I want to do the exact same thing in access.
I know i can't use this code as it is so if anyone knows how to convert it or where i can get help on converting it please let me know.
'Copy and paste reading file to import
Range("A1".Select
Range(ActiveCell, ActiveCell.End(xlDown).End(xlToRight)).Select
Selection.Copy
Windows("MRSO extract.xls".Activate
Worksheets("Import".Activate
Range("a1".Select
ActiveSheet.Paste
'append readings to reading summary file
Workbooks.Open Filename:="S:\readings\READINGS SUMMARY.xls"
Windows("READINGS SUMMARY.xls".Activate
ActiveCell.SpecialCells(xlLastCell).Select
add1 = ActiveCell.Row
Cells(add1, 1).Select
ActiveCell.Offset(2, 0).Value = readfilename
ActiveCell.Offset(3, 0).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
mrncount
first
Worksheets("Import".Activate
Range("a2".Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Resize(, Selection.Columns.Count + 1).Select
Selection.Copy
Worksheets("read out".Activate
Range("a1".Select
ActiveSheet.Paste
'remove trailing spaces from customer name
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Offset(0, 2).Value = "=trim(rc2)"
Range("C1".Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("B1".Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'reformat date
Worksheets("Import".Activate
Range("h2".Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Offset(0, 1).Value = "=value(trim(rc8))"
Range("i2".Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("h2".Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.NumberFormat = "dd-mmm-yy"
'replace "block estimate" and "no reading" and date
Worksheets("Import".Activate
theday = Left(readfilename, 2)
themonth = Mid(readfilename, 3, 2)
theyr = Right(readfilename, 2)
thedate = DateSerial(theyr, themonth, theday)
Range("f2".Select
Do Until IsEmpty(ActiveCell.Value) = True
If Application.IsText(ActiveCell.Value) = True Then
ActiveCell.Value = 0
Selection.Offset(0, 1).Value = "E"
Selection.Offset(0, 2).Value = thedate
End If
Selection.Offset(1, 0).Activate
Loop
'copy the rest to read out
Range("c2".Select
Range(ActiveCell, ActiveCell.End(xlDown).End(xlToRight)).Select
Selection.Copy
Worksheets("read out".Activate
Range("c1".Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'remove trailing spaces from read type
Range("i1".Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Value = "=trim(rc7)"
Columns("i:i".Select
Application.CutCopyMode = False
Selection.Copy
Range("g1".Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("i:i".Select
Selection.Delete Shift:=xlToLeft
'save csv to A drive
Do Until diskette = vbYes
diskette = MsgBox(prompt:="Is there a diskette in drive A?", Buttons:=vbYesNo + vbQuestion)
Loop
On Error GoTo errhandle
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="A:\RE" & readfilename & ".csv", FileFormat:=xlCSV, _
CreateBackup:=False
On Error GoTo 0
ActiveSheet.Name = "read out"
last
errhandle:
If Error() = "Cannot access 'A:'." Then
MsgBox Error() + "Insert floppy disk in drive A."
Resume
Else
MsgBox "File not saved."
Resume Next
End If
End Sub
I have this bit of vba for excel.
I want to do the exact same thing in access.
I know i can't use this code as it is so if anyone knows how to convert it or where i can get help on converting it please let me know.
'Copy and paste reading file to import
Range("A1".Select
Range(ActiveCell, ActiveCell.End(xlDown).End(xlToRight)).Select
Selection.Copy
Windows("MRSO extract.xls".Activate
Worksheets("Import".Activate
Range("a1".Select
ActiveSheet.Paste
'append readings to reading summary file
Workbooks.Open Filename:="S:\readings\READINGS SUMMARY.xls"
Windows("READINGS SUMMARY.xls".Activate
ActiveCell.SpecialCells(xlLastCell).Select
add1 = ActiveCell.Row
Cells(add1, 1).Select
ActiveCell.Offset(2, 0).Value = readfilename
ActiveCell.Offset(3, 0).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
mrncount
first
Worksheets("Import".Activate
Range("a2".Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Resize(, Selection.Columns.Count + 1).Select
Selection.Copy
Worksheets("read out".Activate
Range("a1".Select
ActiveSheet.Paste
'remove trailing spaces from customer name
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Offset(0, 2).Value = "=trim(rc2)"
Range("C1".Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("B1".Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'reformat date
Worksheets("Import".Activate
Range("h2".Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Offset(0, 1).Value = "=value(trim(rc8))"
Range("i2".Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("h2".Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.NumberFormat = "dd-mmm-yy"
'replace "block estimate" and "no reading" and date
Worksheets("Import".Activate
theday = Left(readfilename, 2)
themonth = Mid(readfilename, 3, 2)
theyr = Right(readfilename, 2)
thedate = DateSerial(theyr, themonth, theday)
Range("f2".Select
Do Until IsEmpty(ActiveCell.Value) = True
If Application.IsText(ActiveCell.Value) = True Then
ActiveCell.Value = 0
Selection.Offset(0, 1).Value = "E"
Selection.Offset(0, 2).Value = thedate
End If
Selection.Offset(1, 0).Activate
Loop
'copy the rest to read out
Range("c2".Select
Range(ActiveCell, ActiveCell.End(xlDown).End(xlToRight)).Select
Selection.Copy
Worksheets("read out".Activate
Range("c1".Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'remove trailing spaces from read type
Range("i1".Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Value = "=trim(rc7)"
Columns("i:i".Select
Application.CutCopyMode = False
Selection.Copy
Range("g1".Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("i:i".Select
Selection.Delete Shift:=xlToLeft
'save csv to A drive
Do Until diskette = vbYes
diskette = MsgBox(prompt:="Is there a diskette in drive A?", Buttons:=vbYesNo + vbQuestion)
Loop
On Error GoTo errhandle
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="A:\RE" & readfilename & ".csv", FileFormat:=xlCSV, _
CreateBackup:=False
On Error GoTo 0
ActiveSheet.Name = "read out"
last
errhandle:
If Error() = "Cannot access 'A:'." Then
MsgBox Error() + "Insert floppy disk in drive A."
Resume
Else
MsgBox "File not saved."
Resume Next
End If
End Sub