Sub Export_Panel(wksName As String) Dim strWrkSheet As String
Dim sJobNum As String
Dim sCustomer As String
' Adding String for XML Conversion (BW 20200124)
Dim sName As String
Dim sOut As String
Dim sXtra As String
Dim fh As Long
Dim i As Integer, iu As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim intRowLast As Integer
Dim wkSheet As Worksheet
Dim blnVisible As Boolean
Dim lQty As Long
Dim lRC_Qty As Long
Dim dLength As Double
Dim sProfile As String
Dim dWeight As Double
Set colSheetNames = New Collection
Workbooks(wksName).Activate
strWrkSheet = ActiveSheet.Name
'JobNumber,CustomerName,LineID,RequestedQty,CoilPartNum,LENGTH,Profile,Color,PieceMark,Description,BundleMark,Weight
For Each wkSheet In ActiveWorkbook.Worksheets
If Left(wkSheet.Name, 8) = "PINN PAN" Then
colSheetNames.Add (wkSheet.Name)
End If
Next wkSheet
If ConfirmWeights("Panel") = False Then Exit Sub
' PrepareImportPage4Panel (wksName)
'****************************************************
'Stop 'For Debugging Prep code! Rem when not in use.*
'****************************************************
fh = FreeFile
Sheets("PINN PANEL").Select
sJobNum = Cells(2, 5).Value
If Val(Left$(sJobNum, 1)) = 0 Then
sJobNum = Format$(Now(), "yy") & sJobNum
ElseIf Left$(sJobNum, 1) > 6 Then
sJobNum = "0" & sJobNum
End If
If InStr(sJobNum, ",") <> 0 Then sJobNum = Replace(sJobNum, ",", "")
' Open "\\BR_Panel\Panel$\" & sJobNum & "-Panel.csv" For Output As #fh <--- ORIGINAL Line
' Open "C:\" & sJobNum & "-Panel.csv" For Output As #fh
Open "\\fileserver\Bradbury-Xfer\Panel\" & sJobNum & "-Panel.csv" For Output As #fh
' variable for XML conversion (BW 20200124)
sName = "\\fileserver\Bradbury-Xfer\Panel\" & sJobNum & "-Panel"
sOut = "JobNumber,CustomerName,LineID,RequestedQty,CoilPartNum,Length,Profile,Color,PieceMark,Description,BundleMark,Weight"
Print #fh, sOut ' Header
sCustomer = Replace(Cells(3, 5).Value, ",", "")
sOut = sJobNum & "," & sCustomer
l = 1
For i = 1 To colSheetNames.Count
If blnVisible = True Then blnVisible = False
If Sheets(colSheetNames(i)).Visible = False Then
Sheets(colSheetNames(i)).Visible = True
blnVisible = True
End If
Sheets(colSheetNames(i)).Select
ActiveSheet.Range("A65536").End(xlUp).Select
intRowLast = Int(Right(ActiveCell.Address, Len(ActiveCell.Address) - 3))
For j = 12 To intRowLast
If Val(Cells(j, 1).Value) <> 0 _
And InStr(UCase(Cells(j, 4).Value), "LITE") = 0 _
And InStr(UCase(Cells(j, 4).Value), "SKY") = 0 Then
lQty = Cells(j, 1).Value
sProfile = Mid$(Cells(j, 4).Value, 4)
dLength = CInches(Cells(j, 6).Value) / 12 ' Length in feet (decimal)
sOut = sOut & ",Panel" ' LineID
If sProfile = "RC" Then
lRC_Qty = -1 * Int(-1 * lQty * dLength / 10) ' Quantity of 10' sheets
sOut = sOut & ("," & CStr(lRC_Qty)) ' Quantity (4 RCs per sheet)
sOut = sOut & ",00.000X00G" ' CoilPartNumber (bogus for Panel)
sOut = sOut & ",120" ' Length in inches (decimal)
dWeight = lRC_Qty * 28.2 ' 2'-6" RC weighs 7.05 pounds
Else
sOut = sOut & ("," & Cells(j, 1).Value) ' Part quantity
sOut = sOut & ",00.000X00G" ' CoilPartNumber (bogus for Panel)
sOut = sOut & ("," & CInches(Cells(j, 6).Value)) ' Length in inches (decimal)
End If
sOut = sOut & ("," & Trim$(Cells(j, 4).Value)) ' Profile
sOut = sOut & ("," & Left$(Cells(j, 5).Value, 15)) ' Color
'We are having a problem with the Piece Marks and the CTC. The following code
'is simply to work around the issue.
If InStr(UCase(Cells(j, 2).Value), "XTRA") > 0 Then
k = InStr(UCase(Cells(j, 2).Value), "XTRA")
'I do not expect to see 10 or more extra parts, but if it happens we are ready.
Do Until k = 0
If Asc(Mid(UCase(Cells(j, 2).Value), k, 1)) > 47 And _
Asc(Mid(UCase(Cells(j, 2).Value), k, 1)) < 58 Then
sXtra = Mid(UCase(Cells(j, 2).Value), k, 1) & sXtra
End If
k = k - 1
Loop
sOut = sOut & ("," & sXtra & "Xtra") ' Piece mark (modified)
Else
sOut = sOut & ("," & Left$(Cells(j, 2).Value, 25)) ' Piece mark
End If
sOut = sOut & ("," & Left$(Cells(j, 3).Value, 25)) ' Description
sOut = sOut & (",Bundle1") ' Bundle mark
If sProfile = "RC" Then
sOut = sOut & ("," & Format$(dWeight, "#.0###")) ' RC Weight (total)
Else
sOut = sOut & ("," & Format$(Cells(j, 7).Value, "#.0###")) ' Weight (total)
End If
l = l + 1
Print #fh, sOut
sOut = ","
End If
Next j
If blnVisible = True Then Sheets(colSheetNames(i)).Visible = False
Next i
Sheets(strWrkSheet).Select
Range("K10").Select
If Range("K10").Value = "" Then
With Selection
.HorizontalAlignment = xlRight
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Value = "Released"
End With
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
Else
With Selection
.HorizontalAlignment = xlRight
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Value = "Again"
End With
With Selection.Interior
.ColorIndex = 50
.Pattern = xlSolid
End With
End If
Close #fh
' command to convert CSV to XML (BW 20200124)
Shell """C:\ShipperXML\Panel\CsvToXml.exe"" """ & sName & ".csv"" """ & sName & ".xml""", vbNormalFocus
' New XML Conversion
' Shell "C:\Program Files\CSVtoXML\CsvToXml.exe """ & inputFile & """ """ & outputFile, vbNormalFocus
' orginal attempt at converting to xml
' Dim bSaved As Boolean
' bSaved = CSV2XML("\\fileserver\Bradbury-Xfer\Panel\Test", "test.csv", "ConvertedCSV.xml")
' Application.ScreenUpdating = True
' Application.ScreenUpdating = True
' Set colSheetNames = Nothing
End Sub
Wondering of this a protection error that doesn't specifically say it is. We are SO CLOSE...
Originally Posted by arnelgp
Reply With Quote
