Snasui Excel Forum

Code: Select all

Dim hf As Integer
Dim lines As String, buf As String
Dim x As String, y As String, strInsert As String
strInsert = "POPEN;" & vbLf & _
        "DPRNT[SR05*CLEAR];" & vbLf & _
        "DPRNT[SR01*@];" & vbLf & _
        "DPRNT[SR02*#];" & vbLf & _
        "DPRNT[SR03*KGS2];" & vbLf & _
        "DPRNT[SR04*START];" & vbLf & _
        "PCLOS;"
hf = FreeFile
Open "C:\Users\santipon\Downloads\Temp\Forum\KGS001_" For Input As #hf
    Line Input #hf, buf
    lines = VBA.Left$(buf, 500)
Close #hf
x = Application.Trim(Mid(lines, InStr(lines, "(B:") + 3, 13))
y = Application.Trim(Mid(lines, InStr(lines, "(K:") + 3, 13))
strInsert = Replace(strInsert, "#", x)
strInsert = Replace(strInsert, "@", y)
buf = Replace(buf, "(ORIGIN 2 NOT USE)", "(ORIGIN 2 NOT USE)" & vbLf & strInsert)
Cells(31, 1).Value = buf

Code: Select all

Open strFile_Path_In For Input As myFile1
        L = 1
        MsgBox (buf)       
        iCount = 0
        
       Do Until EOF(myFile1)             
            MsgBox (iCount)
            Line Input #myFile1, buf
            
            MsgBox (buf)
            
            iCount = iCount + 1
            
            If iCount = 3 Then Exit Do
                                     
            MsgBox ("Finish1")
            
        Loop  
        Close #1

Code: Select all

iCount = 0
Do Until EOF(myFile1)

    Line Input #myFile1, buf
    iCount = iCount + 1
    If iCount = 50 Then Exit Do
Loop
Close #1

Code: Select all

%
(PROGRAM WAS IMPLEMENTED)
(START OF HEADER)
(INFOMATION)
(ORDER:  3 )
(K:01200        )
(B:61           )
(S:KGS2         )
(MAC:DC5_NEW_BG )
(TBL:DC5        )
(KN-S/10093     )
(M10MS3         )
(ORIGIN 1 X0.000 Y0.000 Z850.000)
(ORIGIN 2 NOT USE)


(CANCEL H/S MODE <DNC>)
M589(H/S MODE OFF<DNC>)
(AAC TO 1800)
G65P8500T1800
(ATC M10MS3 WITH R)
G65P8600T23R5.00
G65P8800(MIRROR.CANSEL)
(NOT.USE2ND.GENTEN)
(CHANGE ANGLE FOR MEASURE)
G65P8351A0.C0.(FOR AT1800)
S1000(CHANGE S-CORD FOR MESURE)
(MESURE TOOL AT BEFORE)
#505=0.30(BEF RIMIT)
G65P8211R5.00T5.00J0.00M0.(MEASURER OF LENGTH)
(CHANGE DIRECTION)
G65P8350A70.000C110.000
(1ST RETURN TO ORIGIN)
G65P8900
(SET TO OFFSET)
G65P8020D23
(F1FEED HIGH/SPEED)
G65P8090I350I650I1400I1400I1400I1450I15000I1000J1975
(HIGH SPEED MODE)
M588S1.(H/S FOR PERFECT FINISH)
(SET OF COOLANT)
M51(GAIB.AIR)
(END OF HEADER)
G01
M03
G91G01Z-53.29F0
X58.419Y335.691
Z-228.597
X14.463Y-39.736Z-15.391F7
X1.607Y-4.415Z-1.71F1
X.154Y-.021Z.065F6
X.235Y-.001Z.025
X.234Y.013Z-.011
X.234Y.022Z-.033
X.135Y.018Z-.034
X.099Y.015Z-.028
X.234Y.041Z-.082
X.233Y.049Z-.099

Code: Select all

(PROGRAM WAS IMPLEMENTED)
(START OF HEADER)
(INFOMATION)
(ORDER:  3 )
(K:01200        )
(B:61           )
(S:KGS2         )
(MAC:DC5_NEW_BG )
(TBL:DC5        )
(KN-S/10093     )
(M10MS3         )
(ORIGIN 1 X0.000 Y0.000 Z850.000)
(ORIGIN 2 NOT USE)
POPEN;
DPRNT[SR05*CLEAR];
DPRNT[SR01*01200];
DPRNT[SR02*61];
DPRNT[SR03*KGS2];
DPRNT[SR04*START];
PCLOS;


(CANCEL H/S MODE <DNC>)
M589(H/S MODE OFF<DNC>)
(AAC TO 1800)
G65P8500T1800
(ATC M10MS3 WITH R)
G65P8600T23R5.00
G65P8800(MIRROR.CANSEL)
(NOT.USE2ND.GENTEN)
(CHANGE ANGLE FOR MEASURE)
G65P8351A0.C0.(FOR AT1800)
S1000(CHANGE S-CORD FOR MESURE)
(MESURE TOOL AT BEFORE)
#505=0.30(BEF RIMIT)
G65P8211R5.00T5.00J0.00M0.(MEASURER OF LENGTH)
(CHANGE DIRECTION)
G65P8350A70.000C110.000
(1ST RETURN TO ORIGIN)
G65P8900
(SET TO OFFSET)
G65P8020D23
(F1FEED HIGH/SPEED)
G65P8090I350I650I1400I1400I1400I1450I15000I1000J1975
(HIGH SPEED MODE)
M588S1.(H/S FOR PERFECT FINISH)
(SET OF COOLANT)
M51(GAIB.AIR)
(END OF HEADER)
G01
M03
G91G01Z-53.29F0
X58.419Y335.691
Z-228.597
X14.463Y-39.736Z-15.391F7
X1.607Y-4.415Z-1.71F1
X.154Y-.021Z.065F6
X.235Y-.001Z.025
X.234Y.013Z-.011
X.234Y.022Z-.033
X.135Y.018Z-.034
X.099Y.015Z-.028
X.234Y.041Z-.082
X.233Y.049Z-.099

Code: Select all

Type Record
 ID As Integer
 Name As String * 20
End Type

Sub Collect_data_from_NC_code()

    Dim myFile1 As Integer
    Dim text As String
    Dim buf As String
    Dim buftext As String
    Dim textline() As String
    Dim iFile As Integer
    
    iFile = FreeFile
    
    
    Const TxtIn1 = "(K:"
    Const TxtIn2 = "(B:"
    Const TxtIn3 = "(S:"
    Const TxtFin = "(ORIGIN 2 NOT USE)"
    Const TxtFin2 = "(END OF FOOTER)"
    Const TxtOut0 = "POPEN;"
    Const TxtOut1 = "DPRNT[SR01*"
    Const TxtOut2 = "DPRNT[SR02*"
    Const TxtOut3 = "DPRNT[SR03*"
    Const TxtOut4 = "DPRNT[SR04*START"
    Const TxtOut5 = "DPRNT[SR05*FINISH"
    Const TxtOut6 = "PCLOS;"
    Const TxtOut7 = "DPRNT[SR05*CLEAR];"
    Const TxtOut8 = "DPRNT[SR04*CLEAR];"

   
    Dim K As String
    Dim B As String
    Dim S As String
    Dim i As Double
    Dim TxtSR01 As String
    Dim TxtSR02 As String
    Dim TxtSR03 As String
    Dim TxtSR04 As String
    Dim TxtSR05 As String
    
    
    
    Dim X As Integer
    Dim C As Integer
    Dim J As Integer
    Dim IngPosition As Long
    
    

    For X = 9 To 38
    
    'Open file
    strFile_Path_In = Cells(X, 1)
    strFile_Path_Out = Cells(X, 11)
    
    'MsgBox (X)
    'MsgBox (Cells(X, 2))
    
    'strFile_Path_In = "D:\Mr.Jirawat\04_OA-support\02-MC\03_Other\Conprosys\Macro\Macro making\file1"
    'strFile_Path_Out = "D:\Mr.Jirawat\04_OA-support\02-MC\03_Other\Conprosys\Macro\Macro making\fileout2"
    
    'textline = Split(buf, vbLf)
    
    
    Open strFile_Path_In For Input As #iFile
      
    Dim MyRecord As Record
    
    Open strFile_Path_In For Random As #1 Len = Len(MyRecord)
    
    IngPosition = 20
    
    Get #1, lngPosition, buf
       
    Close #1
    
  
        textline = Split(buf, vbLf)
       
        
        For i = 0 To UBound(textline)
        
            text = text & textline(i) & vbLf
            If InStr(textline(i), TxtIn1) > 0 Then
                
                MsgBox (textline(i))
        
                TxtSR01 = Replace(textline(i), TxtIn1, "")
                TxtSR01 = Replace(TxtSR01, " ", "")
                TxtSR01 = Replace(TxtSR01, ")", "")
                
                MsgBox (textline(i))
            End If
            If InStr(textline(i), TxtIn2) > 0 Then
                MsgBox (textline(i))
                TxtSR02 = Replace(textline(i), TxtIn2, "")
                TxtSR02 = Replace(TxtSR02, " ", "")
                TxtSR02 = Replace(TxtSR02, ")", "")
                MsgBox (textline(i))
            End If
            If InStr(textline(i), TxtIn3) > 0 Then
                MsgBox (textline(i))
                TxtSR03 = Replace(textline(i), TxtIn3, "")
                TxtSR03 = Replace(TxtSR03, " ", "")
                TxtSR03 = Replace(TxtSR03, ")", "")
                MsgBox (textline(i))
                
                
            End If
            
            If InStr(textline(i), TxtFin) > 0 Then
                ' Found line to insert
                MsgBox (textline(i))
                text = text & TxtOut0 & vbLf
                text = text & TxtOut7 & vbLf
                text = text & TxtOut1 & TxtSR01 & "];" & vbLf
                text = text & TxtOut2 & TxtSR02 & "];" & vbLf
                text = text & TxtOut3 & TxtSR03 & "];" & vbLf
                text = text & TxtOut4 & "];" & vbLf
                text = text & TxtOut6 & vbLf
                
            End If
          
            'If InStr(textline(i), TxtFin2) > 0 Then
                ' Found line to insert
                'text = text & TxtOut0 & vbLf
                'text = text & TxtOut8 & vbLf
                'text = text & TxtOut1 & TxtSR01 & "];" & vbLf
                'text = text & TxtOut2 & TxtSR02 & "];" & vbLf
                'text = text & TxtOut3 & TxtSR03 & "];" & vbLf
                'text = text & TxtOut5 & "];" & vbLf
                'text = text & TxtOut6 & vbLf
                
            'End If
            
        'MsgBox (textline(1))
        
        Next i
        
      'MsgBox (text)
           
           
    Open strFile_Path_Out For Output As #1
    Print #1, text
    MsgBox ("Endloop")
    text = ""
    Close #1
     
     
 
        'Range("A1").Value = Mid(text, K + 3, 5)
        'Range("A2").Value = Mid(text, B + 3, 2)
        'Range("A3").Value = Mid(text, S + 3, 4)
        
    Next X
    
        
End Sub

Code: Select all

Dim buf As String, strFile_Path_In As String
Dim myFile As Integer, i As Integer
strFile_Path_In = "D:\Memo\ProgramInfo.txt"
myFile = FreeFile
Open strFile_Path_In For Input As myFile
Do Until EOF(myFile)
    Line Input #myFile, buf
    i = i + 1
    Cells(i, 2).Value = buf
Loop
Close myFile

Code: Select all

Dim buf As String
 strFile_Path_In = Cells(x,1)
 
 Open strFile_Path_In For input As #1 
  Line input #1,buf  
  Close #1