• Tùy chọn
• Đăng nhập
• Đăng ký
• Xem như trên Máy tính
• Accelerated Mobile Pages Theme

Kiểm tra và die

• Trang chủ

  • Thủ Thuật Access
  • Warehouse
  • Lưu Trữ
  • Phòng thử nghiệm
  • Kiểm tra và die
• Kiểm tra và die

• RE: Kiểm tra và die

  Noname > 10-09-15, 02:05 PM

  Nếu đăng:
  Instr
  (abc def)
  là chết toi. Vậy là nó sẽ áp dụng với bất kỳ hàm nào có dạng cấu trúc như vậy.
  Ngọc

• RE: Kiểm tra và die

  Noname > 10-09-15, 02:06 PM

  Ở bài toán này có nhiều cách giải khác nhau và cần biết các hàm Instr(), Mid(), Left(), Right() xa hơn nữa là InstrRev(), Split()
  1. Duyệt qua toàn chuỗi đầu vào từ đầu đến cuối, kiểm tra từng ký tự xem có phải là dấu "\" không, lấy vị trí của nó và khi duyệt đến hết chuỗi, số thứ tự lớn nhất chính là vị trí của dấu "\" cuối cùng. Hàm Mid + Instr
  (Cách này củ chuối, chạy chậm) - cần vòng lặp
  2. Duyệt chuỗi từ cuối, thấy dấu "\" đầu tiên thì đó chính là điểm bắt đầu tên file. Dùng hàm Mid là trích được tên file - cần vòng lặp
  3. Dùng hàm InstrRev() tìm vị trí ký tự "\" bắt đầu từ cuối chuỗi. - không cần vòng lặp
  4. Dùng hàm Split tách chuỗi đầu vào thành mảng với dấu phân cách phần tử mảng là "\", phần tử cuối cùng của mảng chính là tên file.- không cần vòng lặp
  5. Dùng các đối tượng ngoài (FileScriptingObject) và truy cập thuộc tính của nó.>> Cách này khó - không giải thích.
  
  Vậy đấy. Các bước để viết chương trình để hình thành chương trình lớn là vậy.
  Hy vọng không quá khó để chúng ta bước tiếp.
  Chúc các bạn có buổi tối vui vẻ

• RE: Kiểm tra và die

  paulsteigel > 10-09-15, 02:06 PM

  Chỗ này này...
  1. Duyệt qua toàn chuỗi đầu vào từ đầu đến cuối, kiểm tra từng ký tự xem có phải là dấu "\" không, lấy vị trí của nó và khi duyệt đến hết chuỗi, số thứ tự lớn nhất chính là vị trí của dấu "\" cuối cùng. Hàm Mid + Instr
  (Cách này củ chuối, chạy chậm) - cần vòng lặp

• RE: Kiểm tra và die

  paulsteigel > 10-09-15, 02:09 PM

  Mã:

  Private Function RetrieveInfor(xlsFileName As String, ObjName As Variant, _
    Optional GetHeader As Boolean = False, Optional MSGCNT As Long, _
    Optional MSG1 As String, Optional MSG2 As String, Optional UpdateRecordOnly = False) As BookmarkEnum
    Dim wrdDocs As Object
    Dim i As Long, StCell As Object, dbCell As Object, UnknownFileError As Boolean
    Dim xlSheet As Object
    Dim hdrRow As Long
    
    ' Determine sheet for recording based on some feature appear...
    Dim ItemCount As Long, OldVersion As Boolean
    ItemCount = UBound(ObjName)
    
    ' Open the file
    On Error GoTo ErrHandler
    Set wrdDocs = AppXls.GetOpenExcelFile(xlsFileName)
    If wrdDocs Is Nothing Then GoTo ErrExit

    ' Just check for validity of the sheet
    If Not IsObjectValid(Msg("DB_COND_CIG_1"), wrdDocs, True) Then GoTo ErrHandler
    ' old version of the form - needed some modification
    If Not IsObjectValid("dbStart", wrdDocs) Then
        ' Check for further...
        If IsObjectValid("txt_current_scale_1_2", wrdDocs) And Not IsObjectValid("txt_current_scale_1_2_1", wrdDocs) Then
            OldVersion = True
        Else
            ' unknown error
            UnknownFileError = True
            GoTo ErrHandler
        End If
    End If
    
    ' Ok now just copy across using the fieldMap table
    Dim fldMap As New ADODB.Recordset, SqlTxt As String, SqlValue As String, SqlField, SqlVal As String, k As Long
    Dim tblName As String ' Keeping table name
    Dim CIG_ID As Long, UnitMass As String, UnitQTY As String
    ' For oldversion stuff
    If OldVersion Then
        UnitMass = Msg("MSG_OLD_MSR_UNIT_ALL")
        UnitQTY = Msg("MSG_OLD_MSR_UNIT_KG")
    End If
    SqlTxt = "SELECT a.NameExcel, a.NameAccess, a.FieldType, a.InternalField, a.TableName, a.OldFieldType FROM tblFieldMap AS a " & _
            "ORDER BY a.TableName, a.NameExcel;"

    fldMap.Open SqlTxt, CurrentProject.Connection
    
    SysCmd acSysCmdInitMeter, Replace(MSG1, "%%", MSG2 & "[" & wrdDocs.Name & "]"), MSGCNT
        
    DoEvents
    DoCmd.Hourglass True
    ' Now start preparing the CIG_profile table first
    With fldMap
        ' Step 1... Profile only
        While Not fldMap.EOF
            ' update progress
            SysCmd acSysCmdUpdateMeter, k
            
            If tblName <> "" And tblName <> .Fields("TableName") Then
                If tblName = "tblCIGProfile" Then
                    ' append document path
                    If SqlField <> "" Then
                        ' Only apply with non-blank profile
                        SqlField = Mid(SqlField, 2) & ",document_path"
                        SqlValue = Mid(SqlValue, 2) & ",'" & xlsFileName & "'"
                        If UpdateRecordOnly Then
                            ' Delete this record first
                            SqlTxt = "DELETE * FROM tblCIGProfile_ORG WHERE document_path='" & xlsFileName & "';"
                            CurrentDb.Execute SqlTxt
                        End If
                        
                        SqlTxt = "INSERT INTO tblCIGProfile_ORG(" & SqlField & ") VALUES(" & SqlValue & ");"
                        CurrentDb.Execute SqlTxt
                        ' Now Get CIG ID
                        CIG_ID = Nz(DMax("ID_CIG", "tblCIGProfile_ORG"), 1)
                    End If
                Else
                    ' Check if a field name is repeated then
                    SqlTxt = "INSERT INTO " & Left(tblName, Len(tblName) - 2) & "(ID_CIG" & SqlField & ") VALUES(" & CIG_ID & SqlValue & ");"
                    'Debug.Print SqlTxt
                    CurrentDb.Execute SqlTxt
                    ' Do grouping...
                    DoGrouping CIG_ID
                End If
                
                ' reset SQL variables
                SqlTxt = ""
                SqlField = ""
                SqlValue = ""
            End If
            tblName = .Fields("TableName")
            If Not .Fields("InternalField") Then
                ' only generate SQL with non-blank field
                If IsValidRange(Nz(.Fields("NameExcel"), ""), wrdDocs) Then
                    SqlVal = Trim(wrdDocs.Names(CStr(.Fields("NameExcel"))).RefersToRange)
                    If SqlVal <> "" Then
                        SqlField = SqlField & "," & .Fields("NameAccess")
                        If .Fields("FieldType") = 10 Or .Fields("OldFieldType") = 10 Then
                            SqlValue = SqlValue & "," & "'" & StrQuoteReplace(SqlVal) & "'"
                        Else
                            SqlValue = SqlValue & "," & GetTextFormat(SqlVal)
                        End If
                    End If
                End If
            End If
            fldMap.MoveNext
            k = k + 1
        Wend
    End With
    RetrieveInfor = True
ErrHandler:
    Err.Clear
    On Error Resume Next
    wrdDocs.Close False
    If UnknownFileError Then
        MsgBox Replace(Msg("MSG_UNKNOWN_ERROR_DETECTED"), "%%", "[" & xlsFileName & "]"), vbCritical
    End If
ErrExit:
    Set xlSheet = Nothing
    Set wrdDocs = Nothing
    Debug.Print Err.Description
    Err.Clear
    DoCmd.Hourglass True
End Function

• RE: Kiểm tra và die

  tranthanhan1962 > 10-09-15, 09:23 PM

  Thấy tên chủ đề là “Kiểm tra và Chết”  mình không hiểu gì cả. Nhưng khi đọc thì hình như các bạn đang bàn vấn đề cắt tên file hoặc thư mục gì đó thì phải Nếu đúng như vậy mình giới thiệu một công thức mà mình đã từng sử dụng.
   
  Trong đó:
  strFiledai : Tên đường dẫn + tên file (kể cả phần mở rộng) đây là dữ liệu đã có sẳn.
  strFilengan : tên file (kể cả phần mở rộng)
  strduoiFile : Phần mở rộng
  strThumucnguon: Tên thư mục chứa file
  strTapTin: Tên file không có đuôi
   
  Công thức:
  
  strFilengan = Right(strFiledai, Len(strFiledai) - InStrRev(strFiledai, "\"))
  strduoiFile = "." & Right(strFiledai, Len(strFiledai) - InStrRev(strFiledai, "."))
  strThumucnguon = Left(strFiledai, Len(strFiledai) - Len(strFilengan))
  * Cái này bỏ ký tự "\"
  * Công thức này cũng được nhưng lấy "\"
  strThumucnguon: Left(strFiledai;InStrRev(strFiledai,"\"))
  * Nếu bỏ "\"
  strThumucnguon: Left(strFiledai;InStrRev(strFiledai,"\")-1)
  strTapTin = Left(strFilengan, Len(strFilengan) - Len(strduoiFile))
  
  Không hiểu có phải các bạn đang cần cái này không nhỉ?

• RE: Kiểm tra và die

  Noname > 10-09-15, 11:58 PM

  À không phải anh! Số là diễn đàn mình khoảng 2 tháng nay tự nhiên post một vài từ khóa lên thì nhảy ra trang lỗi 406, not acceptable.
  Liên hệ với host nửa tháng nay mới giải quyết được nên lôi mấy bài đã trước đây post lên nhảy ra lỗi, đem post lại thử!

• RE: Kiểm tra và die

  paulsteigel > 11-09-15, 01:03 PM

  Chỗ này này...
  1. Duyệt qua toàn chuỗi đầu vào từ đầu đến cuối, kiểm tra từng ký tự xem có phải là dấu "\" không, lấy vị trí của nó và khi duyệt đến hết chuỗi, số thứ tự lớn nhất chính là vị trí của dấu "\" cuối cùng. Hàm Mid + Instr
  (Cách này củ chuối, chạy chậm) - cần vòng lặp

• RE: Kiểm tra và die

  Noname > 07-12-16, 11:28 PM

  Public Function Tim(CotDieukien As String)
  Instr(test)
  Dim rst As Recordset
  Dim sql As String

• RE: Kiểm tra và die

  Noname > 07-12-16, 11:31 PM

  Private Function RetrieveInfor(xlsFileName As String, ObjName As Variant, _
      Optional GetHeader As Boolean = False, Optional MSGCNT As Long, _
      Optional MSG1 As String, Optional MSG2 As String, Optional UpdateRecordOnly = False) As BookmarkEnum
      Dim wrdDocs As Object
      Dim i As Long, StCell As Object, dbCell As Object, UnknownFileError As Boolean
      Dim xlSheet As Object
      Dim hdrRow As Long
      
      ' Determine sheet for recording based on some feature appear...
      Dim ItemCount As Long, OldVersion As Boolean
      ItemCount = UBound(ObjName)
      
      ' Open the file
      On Error GoTo ErrHandler
      Set wrdDocs = AppXls.GetOpenExcelFile(xlsFileName)
      If wrdDocs Is Nothing Then GoTo ErrExit
  
      ' Just check for validity of the sheet
      If Not IsObjectValid(Msg("DB_COND_CIG_1"), wrdDocs, True) Then GoTo ErrHandler
      ' old version of the form - needed some modification
      If Not IsObjectValid("dbStart", wrdDocs) Then
          ' Check for further...
          If IsObjectValid("txt_current_scale_1_2", wrdDocs) And Not IsObjectValid("txt_current_scale_1_2_1", wrdDocs) Then
              OldVersion = True
          Else
              ' unknown error
              UnknownFileError = True
              GoTo ErrHandler
          End If
      End If
      
      ' Ok now just copy across using the fieldMap table
      Dim fldMap As New ADODB.Recordset, SqlTxt As String, SqlValue As String, SqlField, SqlVal As String, k As Long
      Dim tblName As String ' Keeping table name
      Dim CIG_ID As Long, UnitMass As String, UnitQTY As String
      ' For oldversion stuff
      If OldVersion Then
          UnitMass = Msg("MSG_OLD_MSR_UNIT_ALL")
          UnitQTY = Msg("MSG_OLD_MSR_UNIT_KG")
      End If
      SqlTxt = "SELECT a.NameExcel, a.NameAccess, a.FieldType, a.InternalField, a.TableName, a.OldFieldType FROM tblFieldMap AS a " & _
              "ORDER BY a.TableName, a.NameExcel;"
  
      fldMap.Open SqlTxt, CurrentProject.Connection
      
      SysCmd acSysCmdInitMeter, Replace(MSG1, "%%", MSG2 & "[" & wrdDocs.Name & "]"), MSGCNT
          
      DoEvents
      DoCmd.Hourglass True
      ' Now start preparing the CIG_profile table first
      With fldMap
          ' Step 1... Profile only
          While Not fldMap.EOF
              ' update progress
              SysCmd acSysCmdUpdateMeter, k
              
              If tblName <> "" And tblName <> .Fields("TableName") Then
                  If tblName = "tblCIGProfile" Then
                      ' append document path
                      If SqlField <> "" Then
                          ' Only apply with non-blank profile
                          SqlField = Mid(SqlField, 2) & ",document_path"
                          SqlValue = Mid(SqlValue, 2) & ",'" & xlsFileName & "'"
                          If UpdateRecordOnly Then
                              ' Delete this record first
                              SqlTxt = "DELETE * FROM tblCIGProfile_ORG WHERE document_path='" & xlsFileName & "';"
                              CurrentDb.Execute SqlTxt
                          End If
                          
                          SqlTxt = "INSERT INTO tblCIGProfile_ORG(" & SqlField & ") VALUES(" & SqlValue & ");"
                          CurrentDb.Execute SqlTxt
                          ' Now Get CIG ID
                          CIG_ID = Nz(DMax("ID_CIG", "tblCIGProfile_ORG"), 1)
                      End If
                  Else
                      ' Check if a field name is repeated then
                      SqlTxt = "INSERT INTO " & Left(tblName, Len(tblName) - 2) & "(ID_CIG" & SqlField & ") VALUES(" & CIG_ID & SqlValue & ");"
                      'Debug.Print SqlTxt
                      CurrentDb.Execute SqlTxt
                      ' Do grouping...
                      DoGrouping CIG_ID
                  End If
                  
                  ' reset SQL variables
                  SqlTxt = ""
                  SqlField = ""
                  SqlValue = ""
              End If
              tblName = .Fields("TableName")
              If Not .Fields("InternalField") Then
                  ' only generate SQL with non-blank field
                  If IsValidRange(Nz(.Fields("NameExcel"), ""), wrdDocs) Then
                      SqlVal = Trim(wrdDocs.Names(CStr(.Fields("NameExcel"))).RefersToRange)
                      If SqlVal <> "" Then
                          SqlField = SqlField & "," & .Fields("NameAccess")
                          If .Fields("FieldType") = 10 Or .Fields("OldFieldType") = 10 Then
                              SqlValue = SqlValue & "," & "'" & StrQuoteReplace(SqlVal) & "'"
                          Else
                              SqlValue = SqlValue & "," & GetTextFormat(SqlVal)
                          End If
                      End If
                  End If
              End If
              fldMap.MoveNext
              k = k + 1
          Wend
      End With
      RetrieveInfor = True
  ErrHandler:
      Err.Clear
      On Error Resume Next
      wrdDocs.Close False
      If UnknownFileError Then
          MsgBox Replace(Msg("MSG_UNKNOWN_ERROR_DETECTED"), "%%", "[" & xlsFileName & "]"), vbCritical
      End If
  ErrExit:
      Set xlSheet = Nothing
      Set wrdDocs = Nothing
      Debug.Print Err.Description
      Err.Clear
      DoCmd.Hourglass True
  End Function

• RE: Kiểm tra và die

  Noname > 07-12-16, 11:37 PM

  sql="S ELECT * F ROM Table1 W HERE NAME='"& CotDieukien &"'"
• Bài trước Bài tiếp