PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197
Basic VB Error --VBForums
Results 1 to 5 of 5

Thread: Basic VB Error -

  1. #1

    Thread Starter
    New Member
    Join Date
    May 2019
    Posts
    2

    Unhappy Basic VB Error -

    Any help with this would be GRATEFULLY appreciated.. Thank you in advance any kind people !

    I am trying to create an excel macro for prism monitoring and cannot figure out why I am receiving these errors :

    "Error Reading CSV File:Problem at Line: 1"

    CSV import format is as follows:


    542345 58689.2 925.142 RX7 542345 58689.7 925.6

    ---------------------

    CODE:
    VB Code:
    1. Option Explicit
    2.  
    3. Public Type PrismMeasurement
    4.      PrismID As String
    5.      Date As Date
    6.      Northing As Double
    7.      Easting As Double
    8.      Elevation As Double
    9. End Type
    10.  
    11.  
    12. Sub ImportCSV()
    13.  
    14.     Const COLUMN_DATE As Integer = 1
    15.     Const COLUMN_NORTH As Integer = 2
    16.     Const COLUMN_EAST As Integer = 3
    17.     Const COLUMN_ELEV As Integer = 4
    18.     Const COLUMN_DELTANORTH As Integer = 5
    19.     Const COLUMN_DELTAEAST As Integer = 6
    20.     Const COLUMN_DELTAELEV As Integer = 7
    21.     Const ROW_STARTMEASURE As Integer = 2
    22.    
    23.     Dim Choice As Variant
    24.     Dim Time As Variant
    25.     Dim CSVFileName As String
    26.     Dim Measurements() As PrismMeasurement
    27.     Dim Measurement As Variant
    28.     Dim PrismCount As Integer
    29.     Dim LineFromFile As String
    30.     Dim LineItems() As String
    31.     Dim LineCount As Integer
    32.     Dim Count As Integer
    33.     Dim LastRow As Integer
    34.    
    35.  
    36.     With Application.FileDialog(msoFileDialogOpen)
    37.         .AllowMultiSelect = False
    38.         .Title = "Select CSV File To Import"
    39.         .InitialFileName = Application.ActiveWorkbook.Path & ""
    40.         .Filters.Clear
    41.         .Filters.Add "CSV Files", "*.csv"
    42.     End With
    43.      
    44.     Choice = Application.FileDialog(msoFileDialogOpen).Show
    45.    
    46.     If Not Choice = False Then
    47.         Do
    48.             Time = Application.InputBox("Enter Measurement Time (eg: 12:00pm): ", "")
    49.         Loop Until IsDate(Time) Or Time = False
    50.     End If
    51.        
    52.     If Not (Choice = False Or Time = False) Then
    53.                
    54.         CSVFileName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
    55.  
    56.         On Error GoTo FileReadError:
    57.        
    58.         Open CSVFileName For Input As #1
    59.                
    60.         LineCount = 0
    61.         PrismCount = 0
    62.  
    63.         Do Until EOF(1)
    64.        
    65.             Line Input #1, LineFromFile
    66.             LineItems = Split(LineFromFile, ",")
    67.             LineCount = LineCount + 1
    68.            
    69.             If UBound(LineItems) = 6 Then
    70.            
    71.                 If IsNumeric(LineItems(0)) And Not LineItems(0) = "0" Then
    72.                    
    73.                     PrismCount = PrismCount + 1
    74.                     ReDim Preserve Measurements(PrismCount)
    75.                                                
    76.                     If IsNumeric(LineItems(1)) And IsNumeric(LineItems(2)) And IsNumeric(LineItems(3)) And IsDate(LineItems(6)) Then
    77.                         Measurements(PrismCount).PrismID = LineItems(4)
    78.                         Measurements(PrismCount).Date = CDate(LineItems(6))
    79.                         Measurements(PrismCount).Northing = CDbl(LineItems(1))
    80.                         Measurements(PrismCount).Easting = CDbl(LineItems(2))
    81.                         Measurements(PrismCount).Elevation = CDbl(LineItems(3))
    82.                     Else
    83.                          Err.Raise vbObjectError + 1000, "", "Problem at Line: " & CStr(LineCount)
    84.                     End If
    85.            
    86.                 End If
    87.            
    88.             End If
    89.              
    90.         Loop
    91.  
    92.         Close #1
    93.  
    94.         PrismCount = 0
    95.        
    96.         For Count = 1 To UBound(Measurements)
    97.    
    98.             If SheetExists(Measurements(Count).PrismID) Then
    99.                            
    100.                 LastRow = Sheets(Measurements(Count).PrismID).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    101.                
    102.                 Sheets(Measurements(Count).PrismID).Cells(LastRow + 1, COLUMN_DATE) = DateValue(Measurements(Count).Date) + TimeValue(CStr(Time))
    103.                 Sheets(Measurements(Count).PrismID).Cells(LastRow + 1, COLUMN_NORTH) = Measurements(Count).Northing
    104.                 Sheets(Measurements(Count).PrismID).Cells(LastRow + 1, COLUMN_EAST) = Measurements(Count).Easting
    105.                 Sheets(Measurements(Count).PrismID).Cells(LastRow + 1, COLUMN_ELEV) = Measurements(Count).Elevation
    106.                
    107.                 Sheets(Measurements(Count).PrismID).Cells(LastRow + 1, COLUMN_DELTANORTH) = "=" & Cells(LastRow + 1, COLUMN_NORTH).Address(False, False) & "-" & Cells(ROW_STARTMEASURE, COLUMN_NORTH).Address(True, False)
    108.                 Sheets(Measurements(Count).PrismID).Cells(LastRow + 1, COLUMN_DELTAEAST) = "=" & Cells(LastRow + 1, COLUMN_EAST).Address(False, False) & "-" & Cells(ROW_STARTMEASURE, COLUMN_EAST).Address(True, False)
    109.                 Sheets(Measurements(Count).PrismID).Cells(LastRow + 1, COLUMN_DELTAELEV) = "=" & Cells(LastRow + 1, COLUMN_ELEV).Address(False, False) & "-" & Cells(ROW_STARTMEASURE, COLUMN_ELEV).Address(True, False)
    110.            
    111.                 PrismCount = PrismCount + 1
    112.                
    113.             End If
    114.    
    115.         Next Count
    116.    
    117.         MsgBox CStr(PrismCount) & " Prisms Imported From CSV File"
    118.        
    119.     End If
    120.  
    121. Exit Sub
    122.  
    123. FileReadError:
    124.     Close #1
    125.     MsgBox "Error Reading CSV File: " & Err.Description & vbNewLine & vbNewLine & "No Prism Data Imported..."
    126.  
    127. End Sub
    128.  
    129.  
    130. Function SheetExists(SheetName As String) As Boolean
    131.     Dim ws As Worksheet
    132.     SheetExists = False
    133.     For Each ws In Worksheets
    134.       If SheetName = ws.Name Then
    135.         SheetExists = True
    136.         Exit Function
    137.       End If
    138.     Next ws
    139. End Function
    Last edited by si_the_geek; May 31st, 2019 at 03:32 AM. Reason: fixed issue with tags

  2. #2
    Super Moderator si_the_geek's Avatar
    Join Date
    Jul 2002
    Location
    Bristol, UK
    Posts
    41,229

    Re: Basic VB Error -

    Welcome to VBForums

    Thread moved from the 'VB.Net' forum to the 'Office Development/VBA' forum.

  3. #3
    PowerPoster
    Join Date
    Dec 2004
    Posts
    24,547

    Re: Basic VB Error -

    as your error handling disguises the real error, it is hard to pinpoint
    according to the sample posted your csv file is not csv, but tab delimited, so the split should be on tab, not comma

    if you need further help post a sample data file, so someone can test the code
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  4. #4

    Thread Starter
    New Member
    Join Date
    May 2019
    Posts
    2

    Re: Basic VB Error -

    Quote Originally Posted by westconn1 View Post
    as your error handling disguises the real error, it is hard to pinpoint
    according to the sample posted your csv file is not csv, but tab delimited, so the split should be on tab, not comma

    if you need further help post a sample data file, so someone can test the code


    Thank you!!!


    Please see sample data file below:

    -----------------------------

    6512203.78 421598.5027 271.2042 MP2
    6512203.772 421598.5144 271.2039 MP2
    6512203.782 421598.502 271.1646 MP2
    6512203.771 421598.5155 271.1956 MP2
    6512203.786 421598.4953 271.1654 MP2 6512203.778 421598.506 271.18674
    6512312.977 421617.2652 270.4097 MP3
    6512312.966 421617.2794 270.4066 MP3
    6512312.981 421617.2621 270.3841 MP3
    6512312.966 421617.2799 270.4024 MP3
    6512312.985 421617.2572 270.3794 MP3 6512312.975 421617.2688 270.39644
    6512450.905 421704.5318 255.9988 MP4
    6512450.899 421704.5397 255.9976 MP4
    6512450.91 421704.5299 255.9741 MP4
    6512450.9 421704.5391 255.9937 MP4
    6512450.912 421704.5285 255.9685 MP4 6512450.905 421704.5338 255.98654

  5. #5
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    1,969

    Re: Basic VB Error -

    LineItems(3) is a String ("RX7"), so your If fails and forks to the Else where you raise your Error.
    And LineItems(6) is not a Date ("925.6")

    EDIT: Agree with pete regarding the separator.
    Something else: Never ever use Variable-Names which are a Type and/or a Function (in your case "Date" as a Member of the UDT)
    One System to rule them all, One IDE to find them,
    One Code to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    For health reasons i try to avoid reading unformatted Code

Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width